View Single Post
 
Old 07-20-2016, 02:17 AM
DougMVP DougMVP is offline Windows 7 32bit Office 2010 32bit
Advanced Beginner
 
Join Date: Nov 2013
Posts: 50
DougMVP will become famous soon enough
Default

Try

Code:
Sub Create_Memory_Map_HyperLinks()
Dim J As Integer
Dim iTableNum As Integer
Dim oTbl As Table
Dim oRow As Row
Dim newfield As Field
Dim hlink As Hyperlink
'Define variables for the processing of cells
Dim oCell As Cell
Dim sCellText As String
'Define variables for the processing of the cells
Dim rw_oCell As Cell
Dim rw_sCellText As String
' Define variable for the Reg Name cell
Dim oRng As Range
' Define variable for the RW cell
Dim RW_oRng As Range
' Define a loop variable to be used for the row being processed
Dim tbl_loop_variable As Integer
' If user is currently not in a table then go to the next table
If Selection.Information(wdWithInTable) = False Then
Selection.GoToNext What:=wdGoToTable
End If
Selection.Bookmarks.Add ("TempBM")
For J = 1 To ActiveDocument.Tables.count
Set oTbl = ActiveDocument.Tables(J)
oTbl.Select
If Selection.Bookmarks.Exists("TempBM") Then
iTableNum = J
Exit For
End If
Next J
ActiveDocument.Bookmarks("TempBM").Select
ActiveDocument.Bookmarks("TempBM").Delete
' MsgBox "The current table is table " & iTableNum

' Set the current table to be the active table
' ActiveDocument.Tables(iTableNum).Select

NumRows = Selection.Tables(1).Rows.count
NumCols = Selection.Tables(1).Columns.count
' MsgBox "The current table has " & NumRows & " Rows"
' MsgBox "The current table has " & NumCols & " Columns"
' now cycle through the rows of the selected table.
tbl_loop_variable = 0
For Each oRow In Selection.Tables(1).Rows
' Need to skip the first two rows of the table
' Select the cell in column 3
tbl_loop_variable = tbl_loop_variable + 1
If tbl_loop_variable > 2 Then
' Handle the Reg Name
Set oRng = oRow.Cells(3).Range
Set oCell = oRow.Cells(3)
sCellText = oCell.Range
' Remove table cell markers from the text.
sCellText = Left$(sCellText, Len(sCellText) - 2)
' Handle the R/W Cell
Set RW_oRng = oRow.Cells(2).Range
Set rw_oCell = oRow.Cells(2)
rw_sCellText = rw_oCell.Range
' Remove table cell markers from the text.
rw_sCellText = Left$(rw_sCellText, Len(rw_sCellText) - 2)
' MsgBox rw_sCellText
' Check the RW Cell to ensure that it is not blank (ie second line of range)
If (rw_sCellText = "R") Or (rw_sCellText = "R/W") Or (rw_sCellText = "W") Or (rw_sCellText = "RW") Then
' MsgBox "In the R/W section"
If sCellText = "Reserved" Then
' MsgBox "Found the Reserved"
Else
If sCellText = " " Then
' MsgBox "Found the Empty Cells"
Else
' MsgBox sCellText
' link2create = "C3_" & oRng
link2create = oRng.Text
Set newfield = ActiveDocument.Fields.Add(oRng, wdFieldEmpty, "HYPERLINK \l " & Chr(34) & "Link2Create" & Chr(34))
Set hlink = oRng.Paragraphs(1).Range.Hyperlinks(1)
hlink.TextToDisplay = "txt2cpy"
End If
End If
End If
End If
Next oRow
End Sub
Reply With Quote