定位并超链接系统.xlb的文件夹

nothingwmm

1. 
   
2. '--------------------------------------------------'
   
3. '   Das Excel-VBA-Codebook 2007                    '
   
4. '   Alle Rechte vorbehalten                        '
   
5. '   Melanie Breden und Michael Schwimmer           '
   
6. '--------------------------------------------------'
   
7. Option Explicit
   
8. Public Sub GetxlbPath()
   
9.    Dim strFile As String
   
10.    Dim strPath As String
    
11.    
    
12.    ' Excel-Version ermitteln
    
13.    Select Case Val(Application.Version)
    
14.       Case 9
    
15.          strFile = "Excel"
    
16.       Case 10
    
17.          strFile = "Excel10"
    
18.       Case 11
    
19.          strFile = "Excel11"
    
20.       Case 12
    
21.          strFile = "Excel12"
    
22.       Case Else
    
23.          MsgBox "Die Excel-Version konnte nicht identifiziert" & _
    
24.                "werden." & vbNewLine & _
    
25.                "Die Prozedur wird beendet.", _
    
26.                vbExclamation
    
27.          Exit Sub
    
28.    End Select
    
29.    
    
30.    ' Speicherpfad ermitteln
    
31.    strPath = Environ("APPDATA") & "\Microsoft\Excel"
    
32.    
    
33.    MsgBox "Die Befehlsleistendatei befindet sich im Ordner:" & _
    
34.          vbNewLine & vbNewLine & _
    
35.          strPath, _
    
36.          vbInformation, _
    
37.          "Speicherpfad " & strFile & ".xlb"
    
38.          
    
39.    ' Hyperlink in Zelle erstellen
    
40.    With ActiveSheet
    
41.       .Range("C5").Hyperlinks.Add _
    
42.       Anchor:=.Range("C5"), _
    
43.       Address:=strPath, _
    
44.       TextToDisplay:=strFile & ".xlb"
    
45.    End With
    
46. End Sub
    

复制代码