Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Hyperlink auf Sheet in anderer Datei
21.10.2008 08:04:00
Christoph
Hallo zusammen, mal wieder ein kleines Problem:
Ich lese aus einer Zelle den Text Karteikartenneu\A.xls#'Nachname Vorname Ort'!A4 ein.
Ziel des unten stehenden Codes ist es, im Unterverzeichnis Karteikartenneu die Datei A.xls zu öffnen und das Sheet Nachname Vorname Ort im Vordergrund zu aktivieren.
Set zelle = ActiveCell
link = Cells(zelle.Row, 18).Value
If link "" Then
dateiadresse = Left(link, InStr(link, "#") - 1) 'alles was links vom ' steht
kundeadresse = Mid(link, InStr(link, "#") + 1) 'alles was rechts inkl ' steht
ThisWorkbook.FollowHyperlink Address:=dateiadresse, SubAddress:=kundeadresse, NewWindow:=False, AddHistory:=True
Exit Sub
End If
Er öffnet mir zwar die Datei, geht allerdings nichts auf das Sheet. Warum nicht?
Grüße

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink auf Sheet in anderer Datei
21.10.2008 10:10:06
fcs
Hallo Christoph,
die Verarbeitung der SubAddress unter VBA funktioniert scheinbar nicht genau so wie bei einem manuell eingerichteten Hyperlink. Insbesondere dann, wenn der Tabellenname Sonderzeichen enthält und in Hochkommata ("'") eingefasst ist.
Bei mir unter Excel 2003 wird vom Makro manchmal das korrekte Tabellenblatt angewählt, aber die Zelle nicht selektiert.
Mit folgender Anpassung werden Tabelle und die Zelle gemäß Hyperlink selektiert.
Gruß
Franz

Sub aatest()
Dim zelle As Range
Dim dateiadresse As String, kundetabelle As String, link As String, strZelle As String
Set zelle = ActiveCell
link = Cells(zelle.Row, 18).Value
If link  "" Then
dateiadresse = Left(link, InStr(link, "#") - 1) 'alles was links vom ' steht
'Tabellenname isolieren
kundetabelle = Mid(link, InStr(link, "#") + 1, InStr(link, "!") - InStr(link, "#") - 1)
If Left(kundetabelle, 1) = "'" Then
kundetabelle = Mid(kundetabelle, 2, Len(kundetabelle) - 2) 'Tabellenname
End If
strZelle = Mid(link, InStr(link, "!") + 1) 'alles was rechts von ! steht
ThisWorkbook.FollowHyperlink Address:=dateiadresse, _
NewWindow:=False, AddHistory:=True
Worksheets(kundetabelle).Activate
Range(strZelle).Select
Exit Sub
End If
End Sub


Anzeige
AW: Hyperlink auf Sheet in anderer Datei
22.10.2008 08:04:00
Christoph
Hallo, der code funktioniert super. Nur würde ich jetzt noch nach einer Abfrage die geöffnete Datei gerne wieder schließen. In link steht jetzt "A.xls%Nachname Vorname Ort". Das Prozentzeichen trennt Dateiname und Name des Tabellenblatts. Grund ist, dass aus zukünftigen Kundenblättern in meine Masterdatei der link zurückgeschrieben wird (aber die funktion erkämpfe ich mir selber).
verz_karteikarten ist eine globale Variable mit dem String "\Karteikartenneu\".
Und noch was ist mir aufgefallen: Der Befehl Range("A3").Select wird nicht ausgeführt.
Wer kann mir helfen? Vielen Dank schon mal.
Dim zelle As Range
Dim link As String
Dim dateiadresse As String
Dim sheetadresse As String
Set zelle = ActiveCell
link = Cells(zelle.Row, 18).Value
If (link "") And (InStr(1, link, "%") 0) Then
dateiadresse = Mid(verz_karteikarten, 2) & Left(link, InStr(link, "%") - 1)
sheetadresse = Mid(link, InStr(link, "%") + 1)
ThisWorkbook.FollowHyperlink Address:=dateiadresse, NewWindow:=False, AddHistory:=True
Worksheets(sheetadresse).Activate
Range("A3").Select
n = MsgBox("Richtige Kundenkartei gefunden?", vbYesNo, "Richtiger Kunde?")
If n = vbYes Then Exit Sub
End If
'Ab hier kommt noch weiterer Code, der aber noch nicht angepasst ist!
Anzeige
AW: Hyperlink auf Sheet in anderer Datei
22.10.2008 10:21:51
fcs
Hallo Christoph,
bei der Erstellung von Prozeduren, speziell bei komplexeren, sollte man mit Objekt-Variablen arbeiten.
So kann man nach dem Zuweisen eines Objekts an beliebiger Stelle im Code über die Variablen auf die Objekte zugreifen, um Methoden auf sie anzuwenden oder Eigenschaften abzufragen/zu setzen.
In deiner Prozedur machst du dies unmittelbar nach dem Öffnen der Arbeitsmappe via Hyperlink, da diese dann die aktive Arbeitsmappe ist. Ahnliches gilt auch für Tabellenblätter.
Gruß
Franz

Sub aatest()
Dim zelle As Range
Dim link As String
Dim dateiadresse As String
Dim sheetadresse As String
Dim wbAdresse As Workbook, wksAdresse As Worksheet
Dim n As Long
Set zelle = ActiveCell
link = Cells(zelle.Row, 18).Value
If (link  "") And (InStr(1, link, "%")  0) Then
dateiadresse = Mid(verz_karteikarten, 2) & Left(link, InStr(link, "%") - 1)
sheetadresse = Mid(link, InStr(link, "%") + 1)
ThisWorkbook.FollowHyperlink Address:=dateiadresse, NewWindow:=False, AddHistory:=True
Set wbAdresse = ActiveWorkbook
Set wksAdresse = wbAdresse.Worksheets(sheetadresse)
wksAdresse.Activate
Range("A3").Select
n = MsgBox("Richtige Kundenkartei gefunden?", vbYesNo, "Richtiger Kunde?")
If n = vbYes Then Exit Sub
End If
If Not wbAdresse Is Nothing Then wbAdresse.Close
End Sub


Anzeige
AW: Hyperlink auf Sheet in anderer Datei
27.10.2008 10:13:27
Christoph
Hallo Franz,
ich hätte den Code jetzt soweit fertig. Nur frage ich mich, ob er etwas optimiert werden müsste.
könntest du mir dabei helfen?
Anbei poste ich mal den fertigen, funktionierenden Code.
Das komplette Modul inkl. Dateien möchte ich hier nicht posten, da in den Tabellen vertrauliche Inhalte stehen. Falls es allerdings notwendig ist, sende mir an niitaka82@googlemail.com eine Mail. Ich sende dir dann die Dateien als zip.
Die Fehlerbehandlungsroutine funktioniert zwar, ist jedoch mit goto gelöst. Das mach mir ein bisschen kopfschmerzen. im Teil Direktlink ist das allerdings notwendig, da im Adressblatt eventuell ein Direktlink stehen kann, das sheet aber noch gar nicht existiert.
Und die Suche im Teil Kundenblatt nach Anfangsbuchstabe suchen könnte noch optimiert werden, da bisher nur ein 1:1-Vergleich durchgeführt wird.
Vielen Dank
Christoph

Sub Kundenkarte_oeffnen() 'Kundennummer gehört noch eingefügt
'Variablendeklaration
Dim n As Long
Dim i As Integer
Dim link As String
Dim dateiadresse As String
Dim sheetadresse As String
Dim sheetname As String
Const trennzeichen As String = "%"
Dim zelle As Range
Dim wkb_Ziel As Workbook
Dim wks_Adresse As Worksheet
Dim wkb_Kundenadressen As Workbook
Dim wks_Kundenadressen As Worksheet
Dim tabellenblatt As Worksheet
On Error GoTo fehler_sheet
UserForm4.Hide
Set wks_Kundenadressen = ActiveWorkbook.ActiveSheet
Set wkb_Kundenadressen = ActiveWorkbook
Set zelle = ActiveCell
link = Cells(zelle.Row, 18).Value
'Direkt verlinktes Kundenblatt öffnen
If (link  "") And (InStr(1, link, trennzeichen)  0) Then
dateiadresse = Mid(verz_karteikarten, 2) & Left(link, InStr(link, trennzeichen) - 1)
sheetadresse = Mid(link, InStr(link, trennzeichen) + 1)
ThisWorkbook.FollowHyperlink Address:=dateiadresse, NewWindow:=False, AddHistory:=True
Set wkb_Ziel = ActiveWorkbook
Set wks_Adresse = wkb_Ziel.Worksheets(sheetadresse) 'Fehlerbehandlungsroutine, wenn  _
Sheet nicht existiert
wks_Adresse.Activate
Range("A3").Select
n = MsgBox("Richtige Kundenkartei gefunden?", vbYesNo, "Richtiger Kunde?")
If n = vbYes Then
Call beenden
Set wkb_Ziel = Nothing
Set wks_Adresse = Nothing
Exit Sub
End If
wkb_Ziel.Close
End If
'Kundenblatt in Datei mit Anfangsbuchstaben von Nachname suchen
Set wks_Adresse = Nothing
dateiadresse = Mid(verz_karteikarten, 2) & Left(nachname, 1) & ".xls"
ThisWorkbook.FollowHyperlink Address:=dateiadresse, NewWindow:=False, AddHistory:=True
Set wkb_Ziel = ActiveWorkbook
For Each wks_Adresse In Worksheets
If InStr(wks_Adresse.Name, nachname) > 0 Then 'Die Suchfunktion kann man noch  _
optimieren
wks_Adresse.Activate
n = MsgBox("Richtige Kundenkartei gefunden?", vbYesNo, "Weitersuchen?")
If n = vbYes Then
wks_Kundenadressen.Activate 'Direktlink erstellen
Call schutz_aus
Cells(zelle.Row, 18).Value = wkb_Ziel.Name & trennzeichen & wks_Adresse.Name
Call schutz_ein
Call beenden
wks_Adresse.Activate
Set wkb_Ziel = Nothing
Set wks_Adresse = Nothing
Set wkb_Kundenadressen = Nothing
Set wks_Kundenadressen = Nothing
Exit Sub
End If
End If
Next wks_Adresse
fehler_sheet:
'Abfrage ob Kundenkartei angelegt werden soll. Bei Nein beenden und zurück zur Userform
n = MsgBox("Keine Kundenkartei gefunden. Kunde neu anlegen?", vbYesNo, "Neu Anlegen?")
If n = vbNo Then
wkb_Ziel.Close
wks_Kundenadressen.Activate 'Direktlink erstellen
Call schutz_aus
Cells(zelle.Row, 18).Value = ""
Call schutz_ein
Set wkb_Ziel = Nothing
Set wks_Adresse = Nothing
Set wkb_Kundenadressen = Nothing
Set wks_Kundenadressen = Nothing
UserForm4.Show
Exit Sub
End If
'Kundenkartei neu anlagen
wkb_Kundenadressen.Sheets("Nachname Vorname Ort").Copy After:=wkb_Ziel.Sheets(wkb_Ziel. _
Sheets.Count)
ActiveSheet.Activate
Set wks_Adresse = ActiveSheet
sheetname = nachname & " " & vorname & " " & ort
ActiveSheet.Name = Left(sheetname, 30)
wks_Kundenadressen.Activate 'Direktlink erstellen
Call schutz_aus
Cells(zelle.Row, 18).Value = wkb_Ziel.Name & trennzeichen & wks_Adresse.Name
Call schutz_ein
Call beenden
wks_Adresse.Activate
Cells(3, 1).Value = vorname & " " & nachname
Range("A1").MergeArea.ClearContents
Cells(1, 1).Hyperlinks.Add Anchor:=Cells(1, 1), Address:="", SubAddress:="'" & Left( _
nachname, 1) & "'!A1", TextToDisplay:="Zurück zur Namensübersicht " & Left(nachname, 1)
Range("A1").MergeArea.Font.Bold = True
Range("A1").MergeArea.Font.Size = 20
'Neues Inhaltsverzeichnis in Datei erstellen
For Each tabellenblatt In Worksheets
If InStr(tabellenblatt.Name, Left(nachname, 1)) > 0 Then
tabellenblatt.Select
Range("A5:D20").ClearContents
Range("A5:D20").ClearFormats
For i = 1 To Worksheets.Count
Cells(i + 3, 1) = Worksheets(i).Name
Cells(i + 3, 1).Hyperlinks.Add Anchor:=Cells(i + 3, 1), Address:="", SubAddress: _
="'" & Worksheets(i).Name & "'!A3", TextToDisplay:=Worksheets(i).Name
Next i
'Inhaltsverzeichnis sortieren einfügen
Range(Cells(5, 1), Cells(i + 3, 20)).Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom: _
=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A3").Select
Range("A3").Select
Set wkb_Ziel = Nothing
Set wks_Adresse = Nothing
Set wkb_Kundenadressen = Nothing
Set wks_Kundenadressen = Nothing
Exit Sub
End If
Next tabellenblatt
End Sub


Anzeige
AW: Hyperlink auf Sheet in anderer Datei
27.10.2008 14:07:00
fcs
Hallo Christoph,
der Code schaut ganz ordentlich aus. An der einen oder anderen Stelle könnte man sicherlich noch "Activate" oder "Selcet"-Anweisungen vermeiden/weglassen.
Für die Fehlerbehandlung hat sich bei mir das folgende Schema bewährt. Dabei wird die Nummer des aufgetretenen Fehlers in einer Select Case - Anweisung abgefragt und entsprechende Aktionen ausgeführt.
Gruß
Franz

Sub aatest()
Dim abc As Variant
On Error GoTo FehlerBehandlung
'Code für normale Bearbeitung
'Code Teil 1
Resume01: 'Zeile für Rückssprung nach Fehler
'Code Teil 2
FehlerBehandlung:
If Err.Number  0 Then
Select Case Err.Number
Case 70 ' Fehler bei Ordnerzugriff, keine Leseberechtigung
MsgBox "Fehler Nr. " & Err.Number & vbLf & Err.Description _
& "Spezieller Hinweis text"
Resume Next 'Fortsetzung in nächster Zeile in Hauptprozedur
Case 1234
MsgBox "Fehler Nr. " & Err.Number & vbLf & Err.Description _
& "Spezieller Hinweis text"
Resume Resume01 'Fortsetzung an Zeile in Hauptprozedur
Case 567
'Code zur Fehler-Behandlung
'Anschliessend wird Prozedur beendet
Case Else
MsgBox "Fehler Nr. " & Err.Number & vbLf & Err.Description
End Select
End If
'Code der auch nach Fehler noch ausgeführt werden soll
Application.ScreenUpdating = True
End Sub


Anzeige

97 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige