|
一个文件夹下多个同格式表,汇总每张表的某一行到一个花名册里,但是想在汇总的数据后添加所汇总数据来源文件的超链接(hyperlink)。求高手修改代码。
Page
Sub all_libubai() 'by libubai
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim cnn As Object, rs As Object, sql$, mypath$, myfile$
Set cnn = CreateObject("Adodb.Connection")
Set rs = CreateObject("adodb.recordset")
If Application.Version * 1 <= 11 Then
cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='Excel 8.0;imex=1;hdr=no';Data Source=" & ThisWorkbook.FullName
Else
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;imex=1;hdr=no';Data Source=" & ThisWorkbook.FullName
End If
mypath = ThisWorkbook.Path & "\"
myfile = Dir(mypath & "*.xls*")
Range("a2:ae65536").ClearContents
Do While myfile <> ""
If myfile <> ThisWorkbook.Name Then
sql = "select * from [Excel 8.0;imex=1;hdr=no;Database=" & mypath & myfile & "].[汇总册$A2:AE2]"
Set rs = cnn.Execute(sql)
Range("a65536").End(3).Offset(1).CopyFromRecordset rs
End If
myfile = Dir
Loop
rs.Close
Set rs = Nothing
Set cnn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "项目管理人员信息已汇总完成,请查看!", 64, "操作提示"
End Sub
Page
上述代码只完成了汇总工作,如何在AF列添加各自行所引用的文件的超链接呢?
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|