Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 01-29-2019, 04:59 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default URL formatting + a new question

I'm sure I am about to annoy many of you as I have no background in coding or VBA, but I have a problem I'm hoping someone can help me resolve.



I have a 35-page Word document with several hundred embedded links. I need to complete the markdown for this document so that a proprietary Content Management System can read it. For links, the formula is [>URL|TEXT].

For example: Tallinn Botanic Garden appears in the Word document, but I need it to instead read [>http:// botaanikaaed.ee/en|Tallinn Botanic Garden].

To do this manually for hundreds of links is painstaking, so I'm looking for a bit of code that will scan my text for links, extract the URL, then reformat as above.

Is something like this possible?

Thanks in advance for any help.

Last edited by mroatman; 01-29-2019 at 07:40 AM.
Reply With Quote
  #2  
Old 01-29-2019, 06:20 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

I actually may have figured it out just by playing around:

Quote:
Dim HLnk As Hyperlink
For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertAfter "]"
Next

For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertBefore "[>" & HLnk.Address & "|"
Next

Dim oField As Field
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldHyperlink Then
oField.Unlink
End If
Next
Seems to work as expected.
Reply With Quote
  #3  
Old 01-29-2019, 07:37 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

Thanks to both posters in this thread, it has helped me tremendously. I am still stuck on replacing bullets, however.

Like the OP, I want to replace bullets with text. In my case, bullets should appear as[*] (including brackets).

My code and test document are attached. Any ideas what I've done wrong? I guess Chr(149) is not the right character, but I can't identify the correct one.


Quote:
ActiveDocument.Select
Selection.ClearFormatting

Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Range.Paragraphs
With Para.Range
If .Text Like "?" & vbTab & "*" Then
Set Rng = .Duplicate
With Rng
.End = .Start + 2
.Text = vbNullString
.InsertBefore Chr(149) & vbTab
End With
End If
End With
Next

With Selection.Find
.ClearFormatting
.Text = " Chr(149) "
.Replacement.ClearFormatting
.Replacement.Text = "[*] "
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

Dim HLnk As Hyperlink
For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertAfter "]"
Next

For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertBefore "[>" & HLnk.Address & "|"
Next

Dim oField As Field
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldHyperlink Then
oField.Unlink
End If
Next
Set oField = Nothing
Attached Files
File Type: docx test document.docx (43.0 KB, 1 views)

Last edited by mroatman; 01-30-2019 at 12:39 AM.
Reply With Quote
  #4  
Old 01-29-2019, 06:29 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,118
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

to find out what ASCII code number is required to identify your bullets, select one of them and then run the following code in the VBA Immediate Window

? Asc(Selection.Text)

This will return a number which can then be used in your code Chr(xxx)

Note that your code is looking for a bullet with a space either side of it. Typically, bullets are found with a tab after them and nothing before. Check that if you are still not getting hits with that replacement.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #5  
Old 01-30-2019, 12:28 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
to find out what ASCII code number is required to identify your bullets, select one of them and then run the following code in the VBA Immediate Window

Thanks Andrew. Most helpful! After spending 10 minutes figuring out how to pull up the "Immediate window" (🤦*♂️), I was able to figure out the ASCII code: 77.

Unfortunately, even with this modification (and deleting the space before and after the bullet - good tip!), my code still doesn't work. Here is the cleaned up code:

Quote:
Sub TopiaFormat()
'
' TopiaFormat Macro
'

ActiveDocument.Select
Selection.ClearFormatting

Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Range.Paragraphs
With Para.Range
If .Text Like "?" & vbTab & "*" Then
Set Rng = .Duplicate
With Rng
.End = .Start + 2
.Text = vbNullString
.InsertBefore Chr(77) & vbTab
End With
End If
End With
Next

With Selection.Find
.ClearFormatting
.Text = "Chr(77)"
.Replacement.ClearFormatting
.Replacement.Text = "[*] "
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

Dim HLnk As Hyperlink
For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertAfter "]"
Next

For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertBefore "[>" & HLnk.Address & "|"
Next

Dim oField As Field
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldHyperlink Then
oField.Unlink
End If
Next
Set oField = Nothing

ActiveDocument.Select
Selection.ClearFormatting

End Sub
The bullets disappear (good!), but there is no replacement (bad!).

In the "Customize Bulleted list" pane, my bullets are set to Indent at 0.63 cm, with a text position indented at 1.34 cm. Could this have something to do with it?

Thanks again for your help.
Attached Images
File Type: png Screen Shot 2019-01-30 at 09.11.17.png (7.6 KB, 13 views)
Reply With Quote
  #6  
Old 01-30-2019, 10:19 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,118
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

The find/replace section would require "^77" instead of "Chr(77)"

Why are you placing these characters in there before replacing them in the find loop? Surely it would be better to place the[*] in the first place.
With Rng
.End = .Start + 2
.Text = "[*]" & vbTab
End With
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #7  
Old 01-31-2019, 05:03 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

Thanks Andrew. I do not have a good answer to your question as I simply copied the code directly from this thread. I really don't know what I'm doing.

Interestingly, if I replace Chr(77) with "^77" as you suggested, it replaces every 'M' in the document with[*]. So that's something! But I want it to replace the bullets, not the letter M

Very odd.
Attached Images
File Type: png Screen Shot 2019-01-31 at 13.52.27.png (230.6 KB, 11 views)
Reply With Quote
  #8  
Old 01-31-2019, 05:18 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,118
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

The bullet is probably the letter m in a different font (eg Wingdings) so you will most likely need to add that font to the find/replace section of your code.
I think this is something along the lines of...
.Text = "^77"
.Font.Name = "Wingdings"

You need to select a bullet and have a look at what font name is applied to it and replace Wingdings accordingly.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #9  
Old 02-01-2019, 03:04 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
The bullet is probably the letter m in a different font
I discovered the problem. Your helpful code:

? Asc(Selection.Text)

actually doesn't appear to work for these bullets. I suppose this is because automated bullet lists are not treated as standard text. Instead, that formula was retrieving the font code for the next immediate letter -- in this case, M.

I did some digging and discovered the bullet character I'm using is Symbol character 183 (Unicode character F0B7). But I do not know how to plug this information into the

.Text =

field. I looked up a Unicode translation here, but it is not intelligible to me.

Do you know how to write Symbol 183 / Unicode F0B7 in a way that VBA understands?

Thanks again for your ongoing help. I really appreciate it.
Reply With Quote
  #10  
Old 02-01-2019, 03:36 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

As I continued to play around, I was able to achieve what I was looking for. It seems the key was to un-automate the bullet lists via:

ActiveDocument.ConvertNumbersToText

My final input is probably the messiest code on the planet, and I'm sure there are numerous ways to simplify what I have done. But it finally works. So for posterity, in case it's ever helpful to someone else in the future, I will post it below.

Quote:

Sub TopiaFormat()
'
' TopiaFormat Macro
'

ActiveDocument.ConvertNumbersToText

Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Range.Paragraphs
With Para.Range
If .Text Like "?" & vbTab & "*" Then
Set Rng = .Duplicate
With Rng
.End = .Start + 2
.Text = vbNullString
.InsertBefore Chr(149) & vbTab
End With
End If
End With
Next

With Selection.Find
.ClearFormatting
.Text = "^0233"
.Replacement.ClearFormatting
.Replacement.Text = " - "
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

With Selection.Find
.ClearFormatting
.Text = ""
.Replacement.ClearFormatting
.Replacement.Text = "[*]"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

With Selection.Find
.ClearFormatting
.Text = "[*]^w"
.Replacement.ClearFormatting
.Replacement.Text = "[*]"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p^p^p"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

Dim HLnk As Hyperlink
For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertAfter "]"
Next

For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertBefore "[>" & HLnk.Address & "|"
Next

Dim oField As Field
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldHyperlink Then
oField.Unlink
End If
Next
Set oField = Nothing

ActiveDocument.Select
Selection.ClearFormatting

End Sub
Reply With Quote
  #11  
Old 02-01-2019, 04:52 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,118
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

I haven't got your document so I'm not able to test but this is a tidier version of what you had working. I'm still not sure what the loop through the Para's is supposed to achieve but if you are happy with it then that should be fine.
Code:
Sub TopiaFormat()
  Dim Para As Paragraph, Rng As Range, HLnk As Hyperlink
  
  ActiveDocument.ConvertNumbersToText

  For Each Para In ActiveDocument.Range.Paragraphs
    With Para.Range
      If .Text Like "?" & vbTab & "*" Then
        Set Rng = .Duplicate
        With Rng
          .End = .Start + 2
          .Text = Chr(149) & vbTab
        End With
      End If
    End With
  Next

  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .Forward = True
    
    .Text = "^0233"
    .Replacement.Text = " - "
    .Execute Replace:=wdReplaceAll
    
    .Text = ""
    .Replacement.Text = "[*]"
    .Execute Replace:=wdReplaceAll
    
    .Text = "[*]^w"
    .Execute Replace:=wdReplaceAll
    
    .Text = "^p^p"
    .Replacement.Text = "^p^p^p"
    .Execute Replace:=wdReplaceAll
  End With

  For Each HLnk In ActiveDocument.Hyperlinks
    HLnk.Range.InsertAfter "]"
    HLnk.Range.InsertBefore "[>" & HLnk.Address & "|"
    HLnk.Delete
  Next
  
  ActiveDocument.Range.ClearFormatting
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #12  
Old 02-01-2019, 05:17 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

Thanks Andrew. Your revised code is indeed much cleaner, but it wouldn't execute properly for me (error message attached). This may be because I'm running a different version of Word on a Mac. For reference, my test document is in Post 3.

Quote:
Originally Posted by Guessed View Post
I'm still not sure what the loop through the Para's is supposed to achieve
I believe this was to get MS Word to treat the automated bullets as regular text, as otherwise they are handled very differently for automated (vs manual) lists. Macropod states:

Quote:
Originally Posted by macropod View Post
Before you can do anything with those particular bullets, you'll need to convert them to manual bullets - right now, they're automatic bullets. Try:
Code:
Sub ReplaceBullets()
Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Range.Paragraphs
  With Para.Range
    If .Text Like "?" & vbTab & "*" Then
      Set Rng = .Duplicate
      With Rng
        .End = .Start + 2
        .Text = vbNullString
        .InsertBefore Chr(149) & vbTab
      End With
    End If
  End With
Next
End Sub
Somehow, it worked for the other poster in that thread as well, but I can't tell you why.

Thanks again for all your help in getting me here.
Attached Images
File Type: png Screen Shot 2019-02-01 at 14.09.20.png (25.4 KB, 8 views)
Reply With Quote
  #13  
Old 02-01-2019, 08:17 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,118
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

Oh, I hadn't seen the attachment because I was using a mobile phone to view this some of the time. Try this version of the code
Code:
Sub TopiaFormat()
  Dim Para As Paragraph, Rng As Range, i As Integer
  
  ActiveDocument.ConvertNumbersToText

  For Each Para In ActiveDocument.Range.Paragraphs
    With Para.Range
      If .Text Like "?" & vbTab & "*" Then
        Set Rng = .Duplicate
        With Rng
          .End = .Start + 2
          .Text = "[*]" & vbTab
        End With
      End If
    End With
  Next

  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .Forward = True
    
    .Text = "^233"
    .Replacement.Text = " - "
    .Execute Replace:=wdReplaceAll
    
    .Text = ""
    .Replacement.Text = "[*]"
    .Execute Replace:=wdReplaceAll
    
    .Text = "[*]^w"
    .Execute Replace:=wdReplaceAll
    
    .Text = "^p^p"
    .Replacement.Text = "^p^p^p"
    .Execute Replace:=wdReplaceAll
  End With

  For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
    With ActiveDocument.Hyperlinks(i)
      .Range.Text = "[>" & .Address & "|" & .TextToDisplay & "]"
    End With
  Next
  
  ActiveDocument.Range.Font.Reset
  ActiveDocument.Range.Style = "Normal"
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #14  
Old 02-02-2019, 06:49 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
Try this version of the code
That one ran without issue. Thanks for your ongoing support, Andrew.

Hard to imagine, but this small bit of code will save my company something like 10k/year. Amazing what is possible with just a bit of automation.

Thanks again.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Replacing a comment with underline or other formatting (or adding that formatting to commented text) paulkaye Word 4 05-16-2016 05:38 AM
The Logic Behind Apply Formatting of Surrounding Text in Reveal Formatting Pane Instructor Mark Word 4 04-06-2016 01:32 PM
How to do a find and replace on formatting for partial word formatting. BrianSvanvik Word 2 09-04-2015 01:20 PM
Find and Replace, Formatting, Formatting Formula kjxavier Word 1 07-04-2014 09:11 AM
Formatting contents after Tab of continuous lines or formatting specific area of word pawii Word 1 05-12-2014 05:24 AM


All times are GMT -7. The time now is 01:53 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft