aurelyahyjal
06-28-2013, 09:49 AM
Hello--long time reader, 1st time poster. I've searched the forum and haven't found the answer to the question (for the first time, thanks forum!), no doubt due to my poor query syntax. If there is a post that I've missed on point, please direct me to it. Otherwise, I'm hoping you can help me. I'm still pretty new to VBA, so please be gentle if my code below bites.
Here's what I need. I have word document with one table, 2 columns, x number of row (varies weekly). In column 1, there is a string of text in each cell that I need to add a hyperlink to. In addition, the hyperlink changes for each cell based upon info from a smaller string in the previous string. Example:
(Assume in tables(1), columns(1)--# represents a number, which varies from cell to cell)
No. ##-#### [#-###]^p
^p
(<*>).^p
^p
-------------next cell----
No. ##-#### [#-###]^p
^p
(<*>).^p
^p
-I need to add a hyperlink to the entire 1st line of each cell (found by "(No)(*)([\]])")
-The hyperlink address consists of 3 strings. The 3rd string is the numbers found between the brackets in the 1st line of the cell.
-The document will be uploaded, and, for God knows what reason, the document cannot contain any fields except hyperlinks.
-the paragraph marks cannot be included in the hyperlink
Okay, I was using this code previously (parts not relevant omitted), and it worked beautifully, but for some reason, the two paragraphs following the first line were included as part of the hyperlink. I added '26 and '27 to try and fix the problem, and the second paragraph became unlinked, but the one immediately following remained:
Public Sub Macro()
Dim strFDate As String 'data from input box
Dim strBegPTURL As String
Dim oTable As Table
Dim oRow As Row
Dim ocell As Cell
Dim dmyFDate As Date
Dim d As Date
Dim d2 As String
Dim response As String
Dim sTemp As String
Dim sValues As String
Dim oLink As Hyperlink
strBegPTURL = "httpCOLONFSFSwwwDOTmydomainDOTcom/"
strFDate = 20130628 'this number is constant throughout the document, _
'but changes from week to week based on date. Just using today's date _
'as an example, but I've got this worked out.
'21 select [#] to add to url string
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
For Each oTable In ActiveDocument.Tables
For Each oRow In oTable.Rows
'Finds CoA number between brackets in column 1
With Selection.Find
.Text = "([\[])(<[0-9]{1,}>-<[0-9]{3,}>)([\]])"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
If Selection.Find.Execute Then
Selection.Select
sTemp = Selection.Text
sValues = Mid$(sTemp, 2, Len(sTemp) - 2)
'returns number, like 3-152
End If
'22 Add hyperlinks with url and connecting variable (in prog)
Selection.HomeKey Unit:=wdRow ' **correction added--moved extend
Selection.EndKey Unit:=wdLine, Extend:=wdExtend ' **down to endkey unit
Selection.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
strBegPTURL & strFDate & "/" & sValues & ".pdf", _
SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Text
Next
Next
'23 make hyperlinks in hyperlink style
For Each oLink In ActiveDocument.Hyperlinks
oLink.Range.Style = wdStyleHyperlink
Next oLink
'26 Again convert all paragraphs from ^13 to ascii code ^p
ActiveDocument.Select
Selection.WholeStory
Selection.Find.ClearFormatting
With Selection.Find
.MatchWildcards = True
.Text = "^13"
.Replacement.ClearFormatting
.Replacement.Text = "^p"
.Execute MatchWildcards:=True, Forward:=True, Format:=False, _
Replace:=wdReplaceAll
End With
'27 Remove random _ and blue paragraph mark
ActiveDocument.Tables(1).Select
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^13"
.Style = wdStyleHyperlink
.Replacement.ClearFormatting
.Replacement.Text = "^p"
.Replacement.Font.Color = -587137038
.Replacement.Style = wdStyleNormal
.Execute MatchWildcards:=True, Forward:=True, Format:=True, _
Replace:=wdReplaceAll
End With
End Sub
I hope that made sense. Any ideas how to fix it? Thanks in advance for any assistance!
Aurelya
Edit: I made a correction to my '22 above. See **
Here's what I need. I have word document with one table, 2 columns, x number of row (varies weekly). In column 1, there is a string of text in each cell that I need to add a hyperlink to. In addition, the hyperlink changes for each cell based upon info from a smaller string in the previous string. Example:
(Assume in tables(1), columns(1)--# represents a number, which varies from cell to cell)
No. ##-#### [#-###]^p
^p
(<*>).^p
^p
-------------next cell----
No. ##-#### [#-###]^p
^p
(<*>).^p
^p
-I need to add a hyperlink to the entire 1st line of each cell (found by "(No)(*)([\]])")
-The hyperlink address consists of 3 strings. The 3rd string is the numbers found between the brackets in the 1st line of the cell.
-The document will be uploaded, and, for God knows what reason, the document cannot contain any fields except hyperlinks.
-the paragraph marks cannot be included in the hyperlink
Okay, I was using this code previously (parts not relevant omitted), and it worked beautifully, but for some reason, the two paragraphs following the first line were included as part of the hyperlink. I added '26 and '27 to try and fix the problem, and the second paragraph became unlinked, but the one immediately following remained:
Public Sub Macro()
Dim strFDate As String 'data from input box
Dim strBegPTURL As String
Dim oTable As Table
Dim oRow As Row
Dim ocell As Cell
Dim dmyFDate As Date
Dim d As Date
Dim d2 As String
Dim response As String
Dim sTemp As String
Dim sValues As String
Dim oLink As Hyperlink
strBegPTURL = "httpCOLONFSFSwwwDOTmydomainDOTcom/"
strFDate = 20130628 'this number is constant throughout the document, _
'but changes from week to week based on date. Just using today's date _
'as an example, but I've got this worked out.
'21 select [#] to add to url string
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
For Each oTable In ActiveDocument.Tables
For Each oRow In oTable.Rows
'Finds CoA number between brackets in column 1
With Selection.Find
.Text = "([\[])(<[0-9]{1,}>-<[0-9]{3,}>)([\]])"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
If Selection.Find.Execute Then
Selection.Select
sTemp = Selection.Text
sValues = Mid$(sTemp, 2, Len(sTemp) - 2)
'returns number, like 3-152
End If
'22 Add hyperlinks with url and connecting variable (in prog)
Selection.HomeKey Unit:=wdRow ' **correction added--moved extend
Selection.EndKey Unit:=wdLine, Extend:=wdExtend ' **down to endkey unit
Selection.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
strBegPTURL & strFDate & "/" & sValues & ".pdf", _
SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Text
Next
Next
'23 make hyperlinks in hyperlink style
For Each oLink In ActiveDocument.Hyperlinks
oLink.Range.Style = wdStyleHyperlink
Next oLink
'26 Again convert all paragraphs from ^13 to ascii code ^p
ActiveDocument.Select
Selection.WholeStory
Selection.Find.ClearFormatting
With Selection.Find
.MatchWildcards = True
.Text = "^13"
.Replacement.ClearFormatting
.Replacement.Text = "^p"
.Execute MatchWildcards:=True, Forward:=True, Format:=False, _
Replace:=wdReplaceAll
End With
'27 Remove random _ and blue paragraph mark
ActiveDocument.Tables(1).Select
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^13"
.Style = wdStyleHyperlink
.Replacement.ClearFormatting
.Replacement.Text = "^p"
.Replacement.Font.Color = -587137038
.Replacement.Style = wdStyleNormal
.Execute MatchWildcards:=True, Forward:=True, Format:=True, _
Replace:=wdReplaceAll
End With
End Sub
I hope that made sense. Any ideas how to fix it? Thanks in advance for any assistance!
Aurelya
Edit: I made a correction to my '22 above. See **