Hi Guys can someone help me because its really giving me a hard time i am new in creating macro so plz help me as simple as you can :)
I've created a macro for copying and pasting specific text in two different documents. I'm almost done with this. The process while running the macro is working fine but the problem is when i click the done message my ms word become not responding i really don't know why but sometimes it's working.
Can someone help me figuring out the problem or can someone reconstruct my codes for a better output thanks.
enter code here
Dim iCount As Long
iCount = 0
Dim MyAr() As String
Dim i As Integer
i = 0
Do
ContinueLoop:
iCount = iCount + 1
Selection.EndKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "checksum*>"""
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute = False Then
MSG = MsgBox("Done Checking")
Selection.Find.Text = ","
Selection.Find.Execute Replace:=wdReplaceAll
Exit Do
Else
End If
Selection.MoveRight unit:=wdCharacter, Count:=2
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*?.pdf"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
ReDim Preserve MyAr(i)
MyAr(i) = Selection
Windows(1).Activate
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = MyAr(0)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute = True Then
Selection.Find.ClearFormatting
With Selection.Find
.Text = "keying*>"""
.Replacement.Text = ""
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, Count:=2
Windows(2).Activate
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveDown unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Cut
Windows(1).Activate
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Windows(2).Activate
Else
Windows(2).Activate
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveDown unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.HomeKey unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.Find.Text = "ck"
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.TypeText Text:=","
GoTo ContinueLoop
End If
Loop While Selection.Find.Execute = False
I think you have an endless loop - change the last line to "Loop while selection.find.execute = true" so it will stop searching once the find = false.
Related
I often use a legacy text editor (Vim) to take meeting notes because I can keep up with the talking. However, most people (including myself) prefer the final notes to be in Word, with bullets and sub-bullets. Here is an example of a text file that I wanted to convert to Word bullets:
Meeting notes
-------------
* The quick brown fox
* The quick brown fox
- Jumped over the lazy dogs
- Jumped over the lazy dogs
* The quick brown fox
I recorded a macro to convert text bullets to Word bullets. Any paragraph starting with text bullet "*" gets converted to "List Bullet 2", then I globally replace "*" with "" (i.e., deleted). Any paragraph starting with the more indented text bullet " -" gets converted to "List Bullet 4", then I globally delete " -". The "BulletsTxt2wrd" macro is shown below.
The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph. If there is a "*" in the middle of the paragraph (perhaps "25 * 3.1415"), the same paragraph formatting and deletion occurs.
Regular expressions can confine searches to the start of a paragraph. I used regular expressions in a unix environment, and after years of reading that it can be done in VBA, I used it in simple Excel function to convert time durations specified in days/minutes to hours. For example (see "DurtnStr2hrs" function below:
"20 hours" becomes 20
"1 hour" becomes 1
"1 day" becomes 24
"3 days" becomes 3*24
"1 minute" becomes 1/60
"70 minutes" becomes 70/60
I use this function within a spreadsheet cell, with the argument being another cell containing the string to be converted.
Is there a way to use the regular expression package and objects in the "BulletsTxt2wrd" Word macro? It seems to function like a black box, and the VBA code doesn't really expose the object property containing the string that I want to operate on.
P.S. This post doesn't deal with the Find/Replace method that I recorded, which goes through the entire document to locate matches.
This post refers to VBScript, but I really would like to avoid having to figure out another language to accomplish my simple task.
This post also doesn't use the Find/Replace recorded in my macro.
Sub BulletsTxt2wrd()
'
' BulletsTxt2wrd Macro
'
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 2")
With Selection.Find
.Text = " * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 4")
With Selection.Find
.Text = " - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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
End Sub
Function DurtnStr2hrs(str) As Double
' Use for DurtnHrs column
Dim NewStr As String
Dim regex1 As Object
Set regex1 = New RegExp
NewStr = str
regex1.Pattern = " hours?"
NewStr = regex1.Replace(NewStr, "")
regex1.Pattern = " minutes?"
NewStr = regex1.Replace(NewStr, "/60")
regex1.Pattern = " days?"
NewStr = regex1.Replace(NewStr, "*24")
DurtnStr2hrs = Evaluate(NewStr)
End Function
«The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph» Au contraire, you could use:
Sub Demo1()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13[ *-]{1,}"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Start = .Start + 1
Select Case Trim(.Text)
Case "*": .Paragraphs.Last.Style = wdStyleListBullet2
Case "-": .Paragraphs.Last.Style = wdStyleListBullet4
End Select
.Text = vbNullString
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
As for the DurtnStr2hrs conversion, I note there remains a disconnect between your text description of ""20 hours" becomes 20*60" and your Regex of "NewStr = regex1.Replace(NewStr, "/60")". That said, try:
Sub Demo2()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<[0-9]# [dh][ao][yu]*>"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Start = .Start + 1
Select Case Split(.Text, " ")(1)
Case "hour": .Text = Split(.Text, " ")(0)
Case "hours": .Text = Split(.Text, " ")(0) & "/60"
Case "day": .Text = "24"
Case "days": .Text = Split(.Text, " ")(0) & "*24"
End Select
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
The following seems to do the job:
Sub BulletTxt2doc()
doL1bullet:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
If .Found = True Then
Selection.EndKey Unit:=wdLine
Selection.Style = ActiveDocument.Styles("List Bullet 2")
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
GoTo doL1bullet
End If
End With
doL2bullet:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
If .Found = True Then
Selection.EndKey Unit:=wdLine
Selection.Style = ActiveDocument.Styles("List Bullet 4")
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
GoTo doL2bullet
End If
End With
End Sub
I'm trying to select any bolded & underlined text in a paragraph (in Microsoft word 2016). I really just want to select the text so I can manipulate in various ways (which will constantly vary depending on my needs for that specific text), eg highlight, unbold, copy etc.
I created the below macro using the macro recorder feature and when I was doing it it worked perfectly. But when I subsequently ran the macro it highlighted the whole paragraph, as opposed to just the bolded & underlined parts.
Sub SelectBoldandUnderlineCurrentParagraph()
'
' SelectBoldandUnderlineCurrentParagraph Macro
'
'
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Find.ClearFormatting
With Selection.Find.Font
.Bold = True
.Underline = wdUnderlineSingle
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
Try:
Sub Demo()
With Selection.Paragraphs.First.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Text = ""
.Replacement.Text = ""
.Format = True
.Forward = True
.Wrap = wdFindStop
.Execute
End With
.Select
End With
End Sub
How do I find a phrase, go to the beginning of the line the phrase is in, insert a page break, then execute the macro again.
I have attempted the following but it will not go to the following value of "Agent Name" upon subsequent execution.
Sub mFI()
' ' mFI Macro ' '
Selection.MoveRight Unit:=wdCharacter, Count:=1
With Selection
.Find
.ClearFormatting
.Forward = True
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Agent Name"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdPageBreak, Count:=1
End Sub
assuming code you provided is correct, This will help you.
Sub mFI()
' ' mFI Macro ' '
Selection.MoveRight Unit:=wdCharacter, Count:=1
With Selection
.Find
.ClearFormatting
.Forward = True
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Agent Name"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdPageBreak, Count:=1
With Selection
.Find
.ClearFormatting
.Forward = True
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Agent Name"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
End Sub
IF you want to insert page break to all the occurrences of agent name you could try.
Sub Demo()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Agent Name"
.Replacement.Text = "^m^&"
.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
I have recorded a simple macro to find the word "Quantity", go to the end of that line and insert a carriage return. I need to repeat it to the end of the document and quit, or else I'll have an infinite loop.
The code:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Quantity:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Change you code to this, note the use of wdFindStop.
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Quantity:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
do while Selection.Find.Execute = true
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
loop
If you have the type of documents this can fail on you can use the Selection.Start by
replacing the loop like this:
Dim lastPos As Long
lastPos = -1
Do While Selection.Find.Execute = True
If lastPos > Selection.Start Then Exit Do
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Loop
Add Selection.Find.Execute Replace:=wdReplaceAll after your End with
I have recorded a macro in Word 2007 that finds a word, moves the cursor two lines up, inserts three '***', then highlights the line. It works on the first instance of the found word. I am struggling to get it to repeat throughout the document with all instances of the word I want it to find.
This is the output from my recorded macro. I need the actions to be repeated for each instance of "B,".
Sub HighlightNewItems()
'
' HighlightNewItems Macro
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "B,"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.TypeText Text:="***"
Selection.TypeParagraph
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdRed
Selection.Range.HighlightColorIndex = wdRed
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Try putting the following construct within your With.Selection.Find
Do While .Execute
'(logic that you want to apply after finding string)
Loop
In your case, your code would look like
Sub HighlightNewItems()
'
' HighlightNewItems Macro
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "B,"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.TypeText Text:="***"
Selection.TypeParagraph
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdRed
Selection.Range.HighlightColorIndex = wdRed
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
End With
End Sub