Rakesh
03-18-2013, 03:16 AM
Hi Rocks,
The below macro works fine. But sometimes it shows the following error
Run-time error '5':
Invalid procedure call or argument
I’m not good in VB Script. Someone help me.
Attached is sample file where the macro throws error.
Sub 6Col()
Selection.HomeKey Unit:=wdStory
ActiveDocument.Content.Find.execute _
FindText:="^13(Year[!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c tbl hd span:^t\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Class[!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c tbl hd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Per [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Income [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Ratios [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Supplemental [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13([!\@^13]@:^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Total [!^13]@)(^t[!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c entry:$$$<@FH-demi>\1<@$p>\2", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Net expense[!^13]@)(reimbur[!^13]@)(^t[!^13]@)^13", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c entry:$$$\1\3~~~\2^p", _
replace:=wdReplaceAll
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
If Left(para, 1) <> "@" Then
para.Range.InsertBefore "@FH-6c entry:$$$"
End If
Next
ActiveDocument.Content.Find.execute _
FindText:="^13([!\@^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c entry:$$$\1", _
replace:=wdReplaceAll
With Selection.Find
.Text = "$$$"
.Replacement.Text = "<*t(234,"")"",""1 ""285,"")"",""1 ""336,"")"",""1 ""387,"")"",""1 ""438,"")"",""1 ""489,"")"",""1 "")>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.execute replace:=wdReplaceAll
With Selection.Find
.Text = "~~~"
.Replacement.Text = "<\n>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.execute replace:=wdReplaceAll
With Selection.Find
.Text = " "
.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
With Selection.Find
.Text = "<\#209>"
.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
Call Alignment
End Sub
Sub Alignment()
Application.ScreenUpdating = False
Dim i As Long, StrTmp As String, StrOut As String
With ActiveDocument.Content
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
' Find a whole paragraph beginning with <*t.
.Text = "\<\*t*^13"
.execute
End With
Do While .Find.Found
' Copy the paragraph to a string
StrOut = .Text
' Create temporary sub-string arrays, using the tab character
' as the delimiter, ignoring the first array element.
For i = 1 To UBound(Split(StrOut, vbTab))
StrTmp = Split(StrOut, vbTab)(i)
' Strip of the last character of the temporary string,
' until the penultimate character is a number.
While Not IsNumeric(Mid(StrTmp, Len(StrTmp) - 1, 1))
StrTmp = Left(StrTmp, Len(StrTmp) - 1)
Wend
' Get the stripped-down temporary string's last character.
StrTmp = Right(StrTmp, 1)
If IsNumeric(StrTmp) Then StrTmp = ")"
' Replace a character at the calculated position in the
' output string with the temporary string's last character.
Mid(StrOut, ((i) * 12 - 2), 1) = StrTmp
Next
.Text = StrOut
.Find.execute
Loop
End With
Application.ScreenUpdating = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """^p"""
.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
End Sub
Thanks,
Rakesh
The below macro works fine. But sometimes it shows the following error
Run-time error '5':
Invalid procedure call or argument
I’m not good in VB Script. Someone help me.
Attached is sample file where the macro throws error.
Sub 6Col()
Selection.HomeKey Unit:=wdStory
ActiveDocument.Content.Find.execute _
FindText:="^13(Year[!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c tbl hd span:^t\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Class[!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c tbl hd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Per [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Income [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Ratios [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Supplemental [!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13([!\@^13]@:^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-entry subhd:\1", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Total [!^13]@)(^t[!^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c entry:$$$<@FH-demi>\1<@$p>\2", _
replace:=wdReplaceAll
ActiveDocument.Content.Find.execute _
FindText:="^13(Net expense[!^13]@)(reimbur[!^13]@)(^t[!^13]@)^13", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c entry:$$$\1\3~~~\2^p", _
replace:=wdReplaceAll
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
If Left(para, 1) <> "@" Then
para.Range.InsertBefore "@FH-6c entry:$$$"
End If
Next
ActiveDocument.Content.Find.execute _
FindText:="^13([!\@^13]@^13)", _
MatchWildcards:=True, _
ReplaceWith:="^p@FH-6c entry:$$$\1", _
replace:=wdReplaceAll
With Selection.Find
.Text = "$$$"
.Replacement.Text = "<*t(234,"")"",""1 ""285,"")"",""1 ""336,"")"",""1 ""387,"")"",""1 ""438,"")"",""1 ""489,"")"",""1 "")>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.execute replace:=wdReplaceAll
With Selection.Find
.Text = "~~~"
.Replacement.Text = "<\n>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.execute replace:=wdReplaceAll
With Selection.Find
.Text = " "
.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
With Selection.Find
.Text = "<\#209>"
.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
Call Alignment
End Sub
Sub Alignment()
Application.ScreenUpdating = False
Dim i As Long, StrTmp As String, StrOut As String
With ActiveDocument.Content
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
' Find a whole paragraph beginning with <*t.
.Text = "\<\*t*^13"
.execute
End With
Do While .Find.Found
' Copy the paragraph to a string
StrOut = .Text
' Create temporary sub-string arrays, using the tab character
' as the delimiter, ignoring the first array element.
For i = 1 To UBound(Split(StrOut, vbTab))
StrTmp = Split(StrOut, vbTab)(i)
' Strip of the last character of the temporary string,
' until the penultimate character is a number.
While Not IsNumeric(Mid(StrTmp, Len(StrTmp) - 1, 1))
StrTmp = Left(StrTmp, Len(StrTmp) - 1)
Wend
' Get the stripped-down temporary string's last character.
StrTmp = Right(StrTmp, 1)
If IsNumeric(StrTmp) Then StrTmp = ")"
' Replace a character at the calculated position in the
' output string with the temporary string's last character.
Mid(StrOut, ((i) * 12 - 2), 1) = StrTmp
Next
.Text = StrOut
.Find.execute
Loop
End With
Application.ScreenUpdating = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """^p"""
.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
End Sub
Thanks,
Rakesh