关于跨簿互联直通的问题

扑腾

大家新年好！我想操作同一路径下的指定文件夹，该文件夹内有4个工作簿，每簿工作表数量不等，现在想通过代码一键批量给每张工作表添加直通另外3个工作簿的超链接，卡在获取工作簿名称上了，目标要求在附件的“操作表”上。望万能的大神指点，谢谢！




谢谢北极狐工作室大神！祝猪事顺利！

lkqsmxw

http://club.excelhome.net/forum. ... DF8MTQ2MDIyNA%3D%3D
这个文件里有获取工作薄名的模块,自己去看看

扑腾

lkqsmxw 发表于 2019-2-16 19:39
http://club.excelhome.net/forum.php?mod=attachment&aid=MjMxMTcyN3xlYmNjYmU2YXwxNTUwMzE2OTkxfDM4MjMxM ...

感谢帮助，虽然啃起来有些啃不动，但这属于自身问题，谢谢关注和指点！

kzg2013

Sub hyperlinkadd()
dim fso,fd as object
dim n,m as long
Dim ar() As Variant
Set fso = CreateObject("scripting.filesystemobject")
wb = ActiveWorkbook.Path

Set fd = fso.getfolder(wb & "\" & 2019)
   ReDim ar(fd.Files.Count - 1)
   s = 0
For Each xl In fd.Files
   ar(s) = xl.Name
   s = s + 1
Next



For m = 0 To UBound(ar)
    Set sh = GetObject(wb & "\" & 2019 & "\" & ar(m))
        For n = 0 To UBound(ar)
           If ar(n) <> sh.Name Then
              For Each sht In sh.Sheets
                r = sh.Sheets(sht.Name).Range("iv1").End(xlToLeft).Column
                sh.Sheets(sht.Name).Hyperlinks.Add Anchor:=sh.Sheets(sht.Name).Cells(1, r + 1), Address:=wb & "\" & 2019 & "\" & ar(n), _
                TextToDisplay:=fso.getfilename(wb & "\" & 2019 & "\" & ar(n))
              Next
        End If
        Next n
        Application.DisplayAlerts = False
       Application.Windows(sh.Name).Visible = True
       sh.Save
       sh.Close
  Next m

set fso=nothing

  MsgBox "ok"
End Sub

扑腾

kzg2013 发表于 2019-2-16 20:27
Sub hyperlinkadd()
dim fso,fd as object
dim n,m as long

太好使了，非常感谢，祝新的一年一切顺利！