目錄列表超鏈接宏需要移動到另一列

所以在今天早些時候我把我的代碼修復爲超鏈接，但我似乎無法弄清楚如何讓它把列表放在列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？

來源

2013-10-03 Josiah Cowden

這裏是我去的最後一個答案的鏈接t修復我的宏以超鏈接目錄列表。 http://stackoverflow.com/questions/19148596/excel-macro-listing-all-files-within-the-contained-directory-and-hyperlinking-th –

列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)將替代

來源

2013-10-03 07:24:08

非常感謝你的幫助，像一個魅力工程現在我已經準備好明天= P晚安 –

目錄列表超鏈接宏需要移動到另一列

回答

相關問題