PDA

View Full Version : WORD VBA MACRO CRASHES WORD 2007


Maki98
01-31-2011, 06:53 PM
Hi Everyone,

Hope someone here can help me with this issue. I have a macro that is used to compress and resize two tables containing technical data. This macro worked fine in Word 2003, but since upgrading to Word 2007 it consistently crashes Word which then gives me the options to recover lost document.

When I look at the recovered document I can see that the first table is compressed and resized as needed but the second table in not touched.

What would make the macro crash Word before it processes the second table, as my knowledge in VBA is very limited I am stuck and can not find the cause. Any help with this will be greatly appreciated.

Here is the complete macro code with the issue:

'Sub: Compresses Canrad table in WORK.doc
Public Sub MAIN()
Dim Counter As Integer
Dim i As Integer
i = 0
Counter = 0

Documents("WORK.doc").Activate
With Documents("WORK.doc")
Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^g"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.HomeKey Unit:=wdStory

' CANRAD_FIX Macro
Selection.Find.ClearFormatting
With Selection.Find
.Text = "TOP OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Top of Form" Then GoTo SKIP1

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP1:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "BOTTOM OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Bottom of Form" Then GoTo SKIP2

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP2:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "TOP OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Top of Form" Then GoTo SKIP3

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP3:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "BOTTOM OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Bottom of Form" Then GoTo SKIP4

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP4:
Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting
Selection.Collapse
Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=1

Do

With Selection.Find

.Text = "ANTENNA NUMBER"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

If .Execute = True Then

Counter = Counter + 1
If Counter = 2 Then

Selection.Collapse
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdMove
Selection.SelectRow
Selection.Rows.Delete

End If

End If

End With
i = i + 1

Loop While i < 2

Selection.Find.ClearFormatting
i = 0
Counter = 0
Selection.Collapse

Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=1
Do

With Selection.Find

.Text = "B End"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

If .Execute = True Then

Counter = Counter + 1

If Counter = 2 Then

Selection.Collapse
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdMove
Selection.SelectRow
Selection.Rows.Delete

End If

End If

End With
i = i + 1

Loop While i < 2

With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(1.5)
.LeftMargin = CentimetersToPoints(0.9)
.RightMargin = CentimetersToPoints(1.5)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(0.75)
.FooterDistance = CentimetersToPoints(0.75)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With

ActiveWindow.ActivePane.LargeScroll Down:=-1

Selection.Find.ClearFormatting
With Selection.Find
.Text = "Mtng"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

If Selection.Text <> "Mtng" Then GoTo FEETAB



Selection.Tables(1).Select
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(27.69)
With Selection.Font
.Name = "Arial"
.Size = 7#
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.SelectRow
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Antenna"
Selection.TypeParagraph
Selection.TypeText Text:="Number"
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(1.2)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(4.9)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

With Selection.Font
.Spacing = -0.2
End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(0.75)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(0.7)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(0.75)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

With Selection.Font
.Spacing = -0.2
End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem REM Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem REM Selection.Columns.PreferredWidth = CentimetersToPoints(1)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(4.2)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(0.7)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(1.1)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(2.4)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(0.6)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
With Selection.Font
.Spacing = -0.2
End With
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(1.75)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(1.2)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(2.65)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn


Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(3.6)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.SelectRow
With Selection.Cells
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = 8911610
End With
With Selection.Font
.Name = "Arial"
.Size = 7#
.Color = wdColorAutomatic
End With
End With
Selection.Tables(1).Select
With Selection.Tables(1)
.TopPadding = CentimetersToPoints(0)
.BottomPadding = CentimetersToPoints(0)
.LeftPadding = CentimetersToPoints(0)
.RightPadding = CentimetersToPoints(0)
.Spacing = CentimetersToPoints(0)
.AllowPageBreaks = True
.AllowAutoFit = True
End With
With Selection.Tables(1)
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth025pt
.DefaultBorderColor = wdColorBlack
End With


'feeder table
FEETAB:

Selection.Find.ClearFormatting
With Selection.Find
.Text = "B End"
.Replacement.Text = ""
.Forward = True
.Wrap = 1
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

If Selection.Text <> "B End" Then GoTo ENDOFSUB

Selection.TypeText Text:=vbTab
Selection.MoveLeft Unit:=wdCell
Selection.TypeText Text:="A End"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="B End"
Selection.MoveLeft Unit:=wdCell
Selection.Tables(1).Select
With Selection.Font
.Name = "Arial"
.Size = 7#
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Feeder"
Selection.TypeParagraph
Selection.TypeText Text:="Number"
Selection.SelectRow
With Selection.Cells
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = 8911610
End With
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleOutset
.LineWidth = wdLineWidth075pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleOutset
.LineWidth = wdLineWidth075pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleOutset
.LineWidth = wdLineWidth075pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = wdColorDarkBlue
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = 2312007
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleOutset
.DefaultBorderLineWidth = wdLineWidth075pt
.DefaultBorderColor = wdColorAutomatic
End With
With Selection.Font
.Name = "Arial"
.Size = 7#
.Bold = True
.Color = wdColorBlack
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(1.4)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(4.2)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(1.3)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(7.8)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(7.8)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Rem Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Rem Selection.Columns.PreferredWidth = CentimetersToPoints(5#)
Selection.Move Unit:=wdColumn, Count:=1
Selection.SelectColumn

Selection.MoveLeft Unit:=wdCharacter, Count:=1


Selection.Tables(1).Select
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(27.69)
With Selection.Tables(1)
.TopPadding = CentimetersToPoints(0)
.BottomPadding = CentimetersToPoints(0)
.LeftPadding = CentimetersToPoints(0)
.RightPadding = CentimetersToPoints(0)
.Spacing = CentimetersToPoints(0)
.AllowPageBreaks = True
.AllowAutoFit = True
End With

With Selection.Tables(1)
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth025pt
.Color = wdColorBlack
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth025pt
.DefaultBorderColor = wdColorBlack
End With

End With
Documents("SRF MACRO 2007.doc").Close

ENDOFSUB:
Selection.Collapse
End Sub
macropod
01-31-2011, 09:25 PM
Hi Maki98,

When posting code, please use the VBA code tags. Otherwise, your code is much harder to read.

On reading your code, it appears that a great deal of it is redundant and, because you use selections extensively where they're not needed, quite inefficient. For example, it appears that all ofDocuments("WORK.doc").Activate
With Documents("WORK.doc")
Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^g"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.HomeKey Unit:=wdStory

' CANRAD_FIX Macro
Selection.Find.ClearFormatting
With Selection.Find
.Text = "TOP OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Top of Form" Then GoTo SKIP1

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP1:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "BOTTOM OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Bottom of Form" Then GoTo SKIP2

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP2:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "TOP OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Top of Form" Then GoTo SKIP3

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

SKIP3:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "BOTTOM OF FORM"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

FINDER$ = Selection

If FINDER$ <> "Bottom of Form" Then GoTo SKIP4

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
could be reduced to:

With Documents("WORK.doc")
With .Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^g"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
.Text = "TOP OF FORM^?"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
.Text = "BOTTOM OF FORM^?"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Beyond that, your code appears to go into some extensive table manipulation (including more Find/Replace operations) but, without recreating your tables, it's not obvious what's supposed to be happening where. It does appear, though, that the extensive moving around the table could be obviated by simply specifying which tables & cells to act on. If you could post a stripped-down copy of your document showing a before & after version of the tables (minus any sensitive information), I'm sure people here could show you how to make that part of the code much more efficient also.
Maki98
02-02-2011, 11:58 PM
Hi Paul,

Thanks for a quick reply. Basically I have not written this macro myself and it has been given to me to try and find out the reason it is crashing during operation.

The main purpose of the macro is two resize two tables with smaller fonts and tighter cell spacing, all the Find/Replace commands as far as I could tell are there to specify specific columns of a particular table.

I have attached a word doc showing the tables as they are before and what they should look like after the macro completes properly. Also in the same doc I will include the resulting tables after the macro crashes.

Hopefully someone will have an idea why macro crashes in word 2007 and not in word 2003, or maybe point me in the right direction of simplifying the macro to make it more efficient in word 2007.

Thanks again for all your help.
Regards
Michael
macropod
02-03-2011, 05:25 AM
Hi Michael,

Changing font attributes should be done via the application & modification of Style definitions, rather than simply over-riding the exisitng Style definitions with hard-formatting.

Nevertheless, since your documents don't have any appropriately-defined Styles for the tables (even the existing used Styles have been over-ridden with hard formatting), here's a macro for the table re-formatting:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Integer
With Documents("WORK.doc")
With .Tables(1)
.TopPadding = 0
.BottomPadding = 0
.LeftPadding = 0
.RightPadding = 0
.Spacing = 0
For i = 1 To 16
.Cell(1, i).Shading.BackgroundPatternColor = wdColorLightYellow
Next
.Columns(1).Width = CentimetersToPoints(1.67)
.Columns(2).Width = CentimetersToPoints(4.47)
.Columns(3).Width = CentimetersToPoints(1.2)
.Columns(4).Width = CentimetersToPoints(1.78)
.Columns(5).Width = CentimetersToPoints(0.86)
.Columns(6).Width = CentimetersToPoints(1.25)
.Columns(7).Width = CentimetersToPoints(3.34)
.Columns(8).Width = CentimetersToPoints(0.79)
.Columns(9).Width = CentimetersToPoints(1.26)
.Columns(10).Width = CentimetersToPoints(1.66)
.Columns(11).Width = CentimetersToPoints(1.63)
.Columns(12).Width = CentimetersToPoints(0.73)
.Columns(13).Width = CentimetersToPoints(2.16)
.Columns(14).Width = CentimetersToPoints(1.16)
.Columns(15).Width = CentimetersToPoints(2.6)
.Columns(16).Width = CentimetersToPoints(1.13)
With .Range
.Fields.Unlink
With .Cells(1).Range.Find
.Text = "^l(Serial)"
.Replacement.Text = ""
.Execute Replace:=wdReplaceOne
End With
With .Font
.Name = "Arial"
.Color = wdColorAutomatic
.Underline = False
.Size = 7
End With
End With
End With
With .Tables(2)
.Rows.First.Shading.BackgroundPatternColor = wdColorLightYellow
.Columns(1).Width = CentimetersToPoints(1.57)
.Columns(2).Width = CentimetersToPoints(2.8)
.Columns(3).Width = CentimetersToPoints(1.38)
.Columns(4).Width = CentimetersToPoints(8.33)
.Columns(5).Width = CentimetersToPoints(8.33)
.Columns(6).Width = CentimetersToPoints(5.04)
With .Range
.Fields.Unlink
With .Font
.Name = "Arial"
.Color = wdColorAutomatic
.Underline = False
.Size = 8
End With
End With
End With
End With
Application.ScreenUpdating = True
End Sub
The above macro should be significantly faster for the table reformatting than the one you're now using.

Note: It's not apparent from the document you posted where the graphic (^g), 'TOP OF FORM' and 'BOTTOM OF FORM' Find/Replace operations come into it or whether any re-formatting of the page layout is required per your original macro, so I haven't included any of that code in the above.