Question

我想在我的活动表上的行“A”中的每个单元格中添加一个超链接（其文件路径为sName + sPath），我找不到办法在不重新检查整个事情的情况下执行此操作。

如果你可以提供帮助，那就太好了。

非常感谢。

这是我得到的：

  Sub PendingReviewers()
  Dim sPath As String, sName As String
  Dim bk As Workbook, sh As Worksheet
  Dim rw As Long

  Set sh = ActiveSheet  '

  sh.Cells.ClearContents

         cRow = 1
         sh.Cells(cRow, 1) = "Document Name"
         sh.Cells(cRow, 2) = "Reviewer"
         sh.Cells(cRow, 3) = "Decision" 'H5

     rw = 2 '  row to write
     sPath = "P:\ISO 9001 Documents\Review Documents\" ' Dir for file location
     sName = Dir(sPath & "*QDRS.xlsx") ' for xl2010 & "*.xlsx"
     Do While sName <> "" 'Loop until filename is blank
     Set bk = Workbooks.Open(sPath & sName)

     sh.Cells(rw, "A") = bk.Name
     sh.Cells(rw, "B") = bk.Worksheets(2).Range("B39")
     sh.Cells(rw, "C") = bk.Worksheets(2).Range("H39")
     sh.Cells(rw, "D") = bk.Worksheets(2).Range("K39")
     sh.Cells(rw, "E") = bk.Worksheets(2).Range("B48")
     sh.Cells(rw, "F") = bk.Worksheets(2).Range("I48")
     sh.Cells(rw, "G") = bk.Worksheets(2).Range("G4")
     sh.Cells(rw, "H") = bk.Worksheets(2).Range("B32")
     sh.Cells(rw, "I") = bk.Worksheets(2).Range("D39")
       rw = rw + 1
     sh.Cells(rw, "A") = bk.Name
     sh.Cells(rw, "B") = bk.Worksheets(2).Range("B40")
     sh.Cells(rw, "C") = bk.Worksheets(2).Range("H40")
     sh.Cells(rw, "D") = bk.Worksheets(2).Range("K40")
     sh.Cells(rw, "I") = bk.Worksheets(2).Range("D40")
       rw = rw + 1
     sh.Cells(rw, "A") = bk.Name
     sh.Cells(rw, "B") = bk.Worksheets(2).Range("B41")
     sh.Cells(rw, "C") = bk.Worksheets(2).Range("H41")
     sh.Cells(rw, "D") = bk.Worksheets(2).Range("K41")
     sh.Cells(rw, "I") = bk.Worksheets(2).Range("D41")
        rw = rw + 1
     sh.Cells(rw, "A") = bk.Name
     sh.Cells(rw, "B") = bk.Worksheets(2).Range("B42")
     sh.Cells(rw, "C") = bk.Worksheets(2).Range("H42")
     sh.Cells(rw, "D") = bk.Worksheets(2).Range("K42")
     sh.Cells(rw, "I") = bk.Worksheets(2).Range("D42")
        rw = rw + 1
     sh.Cells(rw, "A") = bk.Name
     sh.Cells(rw, "B") = bk.Worksheets(2).Range("B43")
     sh.Cells(rw, "C") = bk.Worksheets(2).Range("H43")
     sh.Cells(rw, "D") = bk.Worksheets(2).Range("K43")
     sh.Cells(rw, "I") = bk.Worksheets(2).Range("D43")
        rw = rw + 1
     sh.Cells(rw, "A") = bk.Name
     sh.Cells(rw, "B") = bk.Worksheets(2).Range("B44")
     sh.Cells(rw, "C") = bk.Worksheets(2).Range("H44")
     sh.Cells(rw, "D") = bk.Worksheets(2).Range("K44")
     sh.Cells(rw, "I") = bk.Worksheets(2).Range("D44")


       rw = rw + 1

      bk.Close SaveChanges:=False
     sName = Dir()
     Loop

     End Sub

Answer 1

这是你想要的吗？

在循环之前添加类似link = sPath & sName的内容

替换sh.Cells(rw, "A") = bk.Name

sh.Hyperlinks.Add Anchor:=sh.Cells(rw, 1), Address:=link

将外部超链接添加到Excel活动表

1 个答案: