批量超链接

xyd617

如何在汇总工作簿A列遍历的工作簿名称，同时批量加上超链接？求代码修改

1. Sub test1()
   
2. Dim cnn As Object
   
3. Dim sql2$, sql3$, sql4$, sql5$, sql6$, sql7$, sql8$, sql9$, sql10$, sql11$, sql12$, sql13$, sql14$
   
4. Dim myf, arr(1 To 200, 1 To 14), M%
   
5. Set cnn = CreateObject("ADODB.CONNECTION")
   
6. myf = Dir(ThisWorkbook.Path & "\*.xls*")
   
7. Do While myf <> "" And myf <> ThisWorkbook.Name
   
8.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=NO'; Data Source=" & ThisWorkbook.Path & "" & myf
   
9.     sql2 = "select * from [Check ?????$D7:D7]"
   
10.     sql3 = "select * from [Check ?????$E7:E7]"
    
11.     sql4 = "select * from [Check ?????$F7:F7]"
    
12.     sql5 = "select * from [Check ?????$G7:G7]"
    
13.     sql6 = "select * from [Check ?????$D9:D9]"
    
14.     sql7 = "select * from [Check ?????$E9:E9]"
    
15.     sql8 = "select * from [Check ?????$D10:D10]"
    
16.     sql9 = "select * from [Check ?????$E10:E10]"
    
17.     sql10 = "select * from [Check ?????$F10:F10]"
    
18.     sql11 = "select * from [Check ?????$D12:D12]"
    
19.     sql12 = "select * from [Check ?????$E12:E12]"
    
20.     sql13 = "select * from [Check ?????$F12:F12]"
    
21.     sql14 = "select * from [Check ?????$O12:O12]"
    
22.     M = M + 1
    
23.     arr(M, 1) = Replace(myf, ".xls*", "")
    
24.     arr(M, 2) = cnn.Execute(sql2)(0)
    
25.     arr(M, 3) = cnn.Execute(sql3)(0)
    
26.     arr(M, 4) = cnn.Execute(sql4)(0)
    
27.     arr(M, 5) = cnn.Execute(sql5)(0)
    
28.     arr(M, 6) = cnn.Execute(sql6)(0)
    
29.     arr(M, 7) = cnn.Execute(sql7)(0)
    
30.     arr(M, 8) = cnn.Execute(sql8)(0)
    
31.     arr(M, 9) = cnn.Execute(sql9)(0)
    
32.     arr(M, 10) = cnn.Execute(sql10)(0)
    
33.     arr(M, 11) = cnn.Execute(sql11)(0)
    
34.     arr(M, 12) = cnn.Execute(sql12)(0)
    
35.     arr(M, 13) = cnn.Execute(sql13)(0)
    
36.     arr(M, 14) = cnn.Execute(sql14)(0)
    
37.     cnn.Close
    
38. <b>    Sheets("1-CHECK????").Hyperlinks.Add Anchor:=Cells(M + 3, 1), Address:=myf</b>
    
39.     myf = Dir()
    
40. Loop
    
41. Sheets("1-CHECK????").Range("a4:n999") = ""
    
42. Sheets("1-CHECK????").Range("a4").Resize(M, 14) = arr
    
43. Set cnn = Nothing
    
44. End Sub

复制代码

xyd617

顶一下哈，求大神指点下

xyd617

是要沉了么