Question

我正在尝试使用Excel范围内的数据填充Outlook VBA中的多列列表框。

到目前为止，我已经设法使用代码：

Private Sub CommandButton1_Click()

'Late binding.  No reference to Excel Object required.
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim cRows As Long
Dim I As Long
  Set xlApp = CreateObject("Excel.Application")
  'Open the spreadsheet to get data
  Set xlWB = xlApp.Workbooks.Open("Query Log.xlsx")
  Set xlWS = xlWB.Worksheets(1)
  cRows = xlWS.Range("Guides").Rows.Count - xlWS.Range("Guides").Row + 1
  ListBox1.ColumnCount = 2
  'Populate the listbox.
  With Me.ListBox1
    For I = 2 To cRows
       'Use .AddItem property to add a new row for each record and populate column 0
      .AddItem xlWS.Range("Guides").Cells(I, 1)
      'Use .List method to populate the remaining columns
      .List(.ListCount - 1, 1) = xlWS.Range("Guides").Cells(I, 2)
    Next I
  End With
  'Clean up
  Set xlWS = Nothing
  Set xlWB = Nothing
  xlApp.Quit
  Set xlApp = Nothing
lbl_Exit:
  Exit Sub
End Sub

Excel范围为2列 - 第一列是标题，第二列是Word文档的超链接单元格。

使用上面的代码我可以很好地填充列表框，但我想要做的是当选择其中一行时我希望能够找到相应单元格中的超链接。

例如，范围看起来像：

Guide 1  |  Link to guide (<--- hyperlinked to "guide1.doc")
Guide 2  |  Link to guide (<--- hyperlinked to "guide2.doc")
Guide 3  |  Link to guide (<--- hyperlinked to "guide3.doc")
Guide 4  |  Link to guide (<--- hyperlinked to "guide4.doc")

使用代码我返回超链接文本（例如，“链接到指南”），但我需要超链接位置（例如，“guide1.doc”）。

有没有办法将超链接位置加载到列表框中而无需重写Excel文件？（它是由其他人维护的，所以这是可能的，但这需要很长时间才能完成。）

我希望我能清楚自己要做的事情！

有没有人有任何想法？

由于

Answer 1

你的问题很明确。 Excel有一个Hyperlinks集合，允许您获取超链接的文本和地址。这个集合可以是范围的属性，因此很容易做到你想要的。

第一个示例假定要显示的文本位于超链接上（一般情况）：

Private Sub CommandButton1_Click()

    'Late binding.  No reference to Excel Object required.

    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim cRows As Long
    Dim hLink As Hyperlink
    Dim I As Long

    Set xlApp = CreateObject("Excel.Application")
    'Open the spreadsheet to get data
    Set xlWB = xlApp.Workbooks.Open("Query Log.xlsx")
    Set xlWS = xlWB.Worksheets(1)

    ListBox1.ColumnCount = 2

    'Populate the listbox.
    With Me.ListBox1

        For Each hLink In xlWS.Range("Guides").Hyperlinks

            'Use .AddItem method to add a new row for each record and populate column 0
            .AddItem hLink.TextToDisplay
            'Use .List method to populate the remaining columns
            .List(.ListCount - 1, 1) = hLink.Address

        Next hLink

    End With
    'Clean up
    Set xlWS = Nothing
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing
lbl_Exit:
  Exit Sub
End Sub

第二个例子是针对特定情况，其中文本位于单元格中，超链接位于右侧的一个单元格中：

Private Sub CommandButton1_Click()

    'Late binding.  No reference to Excel Object required.

    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim cRows As Long
    Dim rngGuide As Range
    Dim I As Long

    Set xlApp = CreateObject("Excel.Application")
    'Open the spreadsheet to get data
    Set xlWB = xlApp.Workbooks.Open("Query Log.xlsx")
    Set xlWS = xlWB.Worksheets(1)

    Set rngGuide = xlWS.Range("Guides")

    ListBox1.ColumnCount = 2

    'Populate the listbox.
    With Me.ListBox1

        For I = 1 To rngGuide.Rows.Count

            'Use .AddItem method to add a new row for each record and populate column 0
            .AddItem rngGuide.Cells(I, 1).Value

            'Use .List method to populate the remaining columns
            .List(.ListCount - 1, 1) = rngGuide.Offset(I - 1, 1).Resize(1, 1).Hyperlinks(1).Address

        Next I

    End With
    'Clean up
    Set xlWS = Nothing
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing
lbl_Exit:
  Exit Sub
End Sub

从Excel范围填充Outlook中的列表框 - 获取单元格的超链接

1 个答案: