View Single Post
 
Old 09-18-2014, 12:02 PM
odin odin is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Sep 2014
Posts: 11
odin is on a distinguished road
Default

Greg,

I'm sorry the code was incomplete and cryptic. I want to thank you for your website, it's been a lot of help and a LOT of information. The main code I'm trying to get to work is 95% from your site.

I'm still testing the whole code, so there may be other errors.

The code that works without any issue for inserting a hyperlink is:

Code:
 
Sub insertLink()
Dim dspTxt As String
Dim webTxt As String
dspTxt = "testing Link"
webTxt = "http://www.microsoft.com"
'Write the hyperlink
   ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
        webTxt, SubAddress:="", ScreenTip:="", TextToDisplay:= _
        dspTxt
End Sub
The code above though I should mention is just a standard macro not run from anything other than going to Macros and selecting it to run. And it will insert the hyperlink at the current currsor location.

Here is the whole code below that I'm trying to work out:

Code:
 
Option Explicit
Public oCol As Collection
 
 
Sub AddMaterialCollection()
Dim oFrmInput As fmAddMaterial, oObjForm As Object
Dim bRepeat As Boolean
Dim oCol As Collection
Dim oTbl As Table
Dim lngIndex As Long
Dim webIndex As Long
 
  'Initialize the collection.
  Set oCol = New Collection
 
  'Set up loop to collect repeating section information from document user.
  bRepeat = True
  Do While bRepeat
    Set oFrmInput = New fmAddMaterial
    With oFrmInput
        .StartUpPosition = 0
    .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
    .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    .Show
End With
 
    If oFrmInput.Tag <> "USER CANCEL" Then
      'Add the userform objects to the collection.
      oCol.Add oFrmInput
    Else
      Exit Do
    End If
    bRepeat = oFrmInput.Tag
  Loop
  'Targets document table and output information.
  Set oTbl = ActiveDocument.Tables(1)
    With oTbl
    'Add data to table.
    'On Error GoTo Err_NoRecords
    For lngIndex = 1 To oCol.Count
      Set oObjForm = oCol.Item(lngIndex)
      .Cell(lngIndex + 1, 1).Range.Text = oObjForm.qtyBox.Text
      .Cell(lngIndex + 1, 2).Range.Text = oObjForm.markBox.Text
      .Cell(lngIndex + 1, 3).Range.Text = oObjForm.descBox.Text & " " & "FABRICATE AS SHOWN: "
      Set oObjForm = Nothing
    'Next lngIndex
  'End With
 
    With oTbl
    'Add Links to end of table.
    On Error GoTo Err_NoRecords
    For webIndex = 0 To oCol.Count
      Set oObjForm = oCol.Item(webIndex)
        .Cell(webIndex + 1, 3).Range.End -1 = ActiveDocument.Hyperlinks.Add(oObjForm.webaddTextBox.Text, _
        "", "", TextToDisplay:=oObjForm.dspTextBox.Text)
        Set oObjForm = Nothing
    Next webIndex
  'End With
 
    'Write the hyperlink
   ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
        oObjForm.webaddTextBox.Text, SubAddress:="", ScreenTip:="", TextToDisplay:= _
        oObjForm.dspTextBox.Text
 
  'Report
  MsgBox "Data you entered has been tranfered to the table." & vbCr + vbCr _
       & "You can edit, add or delete information to the defined table as required", _
          vbInformation + vbOKOnly, "DATA TRANSFER COMPLETE"
 
CleanUp:
  Set oTbl = Nothing
  Set oCol = Nothing
  Unload oFrmInput
  Set oFrmInput = Nothing
  Exit Sub
Err_NoRecords:
  MsgBox "You didn't provide any Links." & vbCr + vbCr _
       & "You can edit and add information to the basic table if required", _
       vbInformation + vbOKOnly, "NO DATA PROVIDED"
  Resume CleanUp
End Sub
Another issue I'm having with the code is that it looks like I can't use ".Range.End -1" statement either to try and insert the link or anything at the end of the existing text in a cell in a table. Per the Word help the ".Range.End" is read only and you're not able to write to it.

I hope you can help me figure this thing out.

Thank you,
Michael
Reply With Quote