目录列表超链接宏需要移动到另一列

时间:2013-10-03 06:19:15

标签: excel vba

所以今天早些时候我将我的代码修复为超链接,但我似乎无法弄清楚如何将列表放在列U而不是列A中。

Sub hyperlinker()

  Dim MOG As Object
  Dim rsMOG As Object
  Dim PrimeF As Object
  Dim Bit As Object
  Dim Foder As Object 
  Dim Linger As Integer
  Dim Enigma As String
  Dim Way As String


  'Get the current folder
  Set MOG = CreateObject("scripting.filesystemobject")
  Set PrimeF = MOG.GetFolder(ThisWorkbook.Path)
  Set MOG = Nothing

  'Get the row at which to insert
   Linger = Range("A65536").End(xlUp).row + 1

  'Create the recordset for sorting
   Set rsMOG = CreateObject("ADODB.Recordset")
  With rsMOG.Fields
    .Append "Way", 200, 200
    .Append "Enigma", 200, 200
    .Append "Bit", 200, 200
  End With
  rsMOG.Open

  ' Traverse the entire folder tree
  TraverseFolderTree PrimeF, PrimeF, rsMOG
  Set PrimeF = Nothing

  'Sort by type and name
  rsMOG.Sort = "Bit ASC, Enigma ASC "
  rsMOG.MoveFirst

  'Populate the first column of the sheet
  While Not rsMOG.EOF
    Enigma = rsMOG("Enigma").value
    Way = rsMOG("Way").value
    If (Enigma <> ThisWorkbook.name) Then
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(Linger, 1), Address:=Way, TextToDisplay:=Enigma
      Linger = Linger + 1
    End If
    rsMOG.MoveNext
  Wend

  'Close the recordset
  rsMOG.Close
  Set rsMOG = Nothing

End Sub

Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object)

  'List all files
  For Each Bit In node.Files

    Dim Enigma As String
    Enigma = Mid(Bit.Path, Len(parent.Path) + 2)

    rs.AddNew
    rs("Way") = Way
    rs("Enigma") = Enigma
    rs("Bit") = "Bit"
    rs.Update
  Next

  'List all folders
  For Each Foder In node.SubFolders
    TraverseFolderTree parent, Foder, rs
  Next

End Sub

请原谅索引中的随机单词,由于使用了另一个宏中的常用单词,我不得不将它们更改为奇数名称。

基本上,

dim linger as integer

'Get the row at which to insert
  Linger = Range("A65536").End(xlUp).row + 1

给我一​​栏A无论我放在哪里,有人可以帮助我将这个超链接列表添加到U列吗?

1 个答案:

答案 0 :(得分:1)

U包含21的索引。

所以替换

ActiveSheet.Hyperlinks.Add Anchor:=Cells(Linger, 1), Address:=Way, TextToDisplay:=Enigma

ActiveSheet.Hyperlinks.Add Anchor:=Cells(Linger, 21), Address:=Way, TextToDisplay:=Enigma

您应该可以在U

中获取超链接

查看使用Cells对象时,第一个参数是行号,第二个参数是列号。

因此,Cells(1,1)对应A1,与Range("A1")相同

Cells(linger,21)将是 linger U

列中的价值

Range("U" & linger)将是另类