2

我正在尝试使用 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 文档的超链接单元格。

With the code above I can get the listbox populated fine, but what I want to do is when one of the rows has been selected I want to be able to find out the hyperlink that is in the corresponding cell.

例如，范围如下所示：

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 文件？（它是由其他人维护的，所以它是可能的，但需要很长时间才能这样做）。

我希望我清楚我要做什么！

有没有人有任何想法？

谢谢

4

1 回答 1

0

你的问题很清楚。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
于 2013-04-02T12:03:54.750 回答