EXCEL实现图纸资料管理

Kelidai

给你一段代码参考吧：

1. Private Sub CommandButton2_Click()
   
2. Application.ScreenUpdating = False
   
3. Application.Calculation = xlCalculationManual
   
4. Dim i As Integer
   
5. Dim j As Integer
   
6. Sheet1.Hyperlinks.Delete
   
7. Sheet1.Columns("B:B").HorizontalAlignment = xlCenter
   
8. Dim MyName, Dic, Did, T, F, TT, MyFileName, objShell, objFolder, lj, Ke, sz, Sh, rng As Range, cell As Range
   
9. lj = "\\CH3DDC3\operationalteam\03_PO Report\2012 PO"
   
10.     Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象
    
11.     Set Did = CreateObject("Scripting.Dictionary")
    
12.     Dic.Add (lj), ""
    
13.     i = 0
    
14.     Do While i < Dic.Count
    
15.         Ke = Dic.keys   '开始遍历字典
    
16.         MyName = Dir(Ke(i), vbDirectory)    '查找目录
    
17.         Do While MyName <> ""
    
18.             If MyName <> "." And MyName <> ".." Then
    
19.                 If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录
    
20.                     Dic.Add (Ke(i) & MyName & ""), ""  '就往字典中添加这个次级目录名作为一个条目
    
21.                 End If
    
22.             End If
    
23.             MyName = Dir    '继续遍历寻找
    
24.         Loop
    
25.         i = i + 1
    
26.     Loop
    
27.     Did.Add ("文件清单"), ""
    
28.     For Each Ke In Dic.keys
    
29.         MyFileName = Dir(Ke & "*.*")
    
30.         Do While MyFileName <> ""
    
31.             Did.Add (Ke & MyFileName), ""
    
32.             MyFileName = Dir
    
33.         Loop
    
34.     Next
    
35.     Sh = Did.keys
    
36. For i = 3 To Sheet1.Range("a65535").End(xlUp).Row
    
37.   For j = 0 To Did.Count - 1
    
38.   If Sh(j) Like "*" & Sheet1.Cells(i, 2).Value & "*.*" Then
    
39.   Sheet1.Hyperlinks.Add anchor:=Sheet1.Cells(i, 2), Address:=Sh(j)
    
40.   Exit For
    
41.   End If
    
42.   Next j
    
43.   Next i
    
44. Application.ScreenUpdating = True
    
45. Application.Calculation = xlCalculationAutomatic
    
46. End Sub

复制代码

xjl0711

刚刚打开，还不太会用（本人水平有限），再研究研究。谢谢！

皇朝

WCHGSZ 提供的表格很有用，能告知是怎么做的吗

junzhai

首先感谢5楼分享，我还没看明白怎么用。

992002

非常感谢，真是高大上，Excel真是高深莫测~

sfmyxcpy

感谢5楼分享，这东东能解决我的问题。

Today-跑跑

谢谢5 楼的分享 太棒了

阳光gril

WCHGSZ 发表于 2011-4-24 00:08
楼主大人，
附件资料借花献佛，
看看是否可行。

可以告知VBA密码

jojodss

WCHGSZ 发表于 2011-4-24 00:08
楼主大人，
附件资料借花献佛，
看看是否可行。

这个实在有点厉害

xstv

这个太强大了，发现我一个文件下尽然有1w+的文件。真是吓一跳啊~