Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1448to1452
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Hyperlinks

Hyperlinks
18.09.2015 12:50:00
Yanno
Guten Tag
Habe folgendes vor:
Ich möchte in meiner Excel-Liste, die Zahlen (6 stellig) in Spalte A mit der jeweiligen Datei verlinken (Hyperlink) ( per Makro).
Ich habe 388 Zeilen und möchte nicht in jeder Zelle die Hyperlinks setzen, dies soll automatisch geschehen.
Dass blöde ist es soll mir z. B wenn in zelle X 739639,in Zelle Y 738646 und in Zelle Z 736123 steht jeweils überprüfen ob die ersten 3 Zahlen = 739 738 oder 736 sind und dann je nachdem in verschiedenen Ordnern die Datei(.xls, doc, docx)mit der jeweiligen nummern und pfad in der gleichen Zelle einen Hyperlink machen. Der Hyperlinkname (Anzuzeigender Text) sollte gleich sein wie vorher z. b 739123 (ohne Pfad ohne Dateityp).
Zum Beispiel in A1 steht: 739625
In A2 steht : 738124
Dann soll es prüfen A1 = 739XXX
also
if erste 3 zahlen = 739… then suche im Ordner C:\Users\brandty\_AHB das Dokument 739123.(doc, docx, xlm, pdf) wenn keine Datei mit 739625 dann mache nix sonst setze in Zelle A1 Hyperlink C:\Users\brandty\_AHB\734070&dateityp(gefunden) Anzuzeigender Text= Wert vorher in A1 „739123“
In A2:
if erste 3 zahlen = 738… then suche im Ordner C:\Users\brandty\_Qual das Dokument 738124.(doc, docx, xlm, pdf) wenn keine Datei mit 738124 dann mache nix sonst setze in Zelle A2 Hyperlink C:\Users\brandty\_AHB\734070+dateityp(gefunden)
Dies soll er von A1 – A500 (oder die ganze Spalte A) überprüfen und umsetzen
Meistens sind es Datetypen mit .doc oder .xltx.
Zudem sind es 8 verschieden Unterordner von C:\Users\brandty\ in der er schlussendlich je nachdem ob 731, 732, 733…739 als erste 3 Ziffern steht, nach der jeweiligen Datei suchen soll.
Ist es möglich, dies herzukriegen?
Vielen Dank
Yanno

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

Betreff
Datum
Anwender
Anzeige
AW: Hyperlinks
18.09.2015 14:49:41
matthias
Hallo Yanno,
probier mal dies: 
Sub Hyperlinks()
Dim x As Long
Dim sDateiname As String, sPfad As String, sEndung As String
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
sDateiname = CStr(Cells(x, 1).Value)
'Ordner bestimmen
Select Case Left(sDateiname, 3)
Case "731": sPfad = "C:\Users\brandty\_Ordner1\"
Case "732": sPfad = "C:\Users\brandty\_Ordner2\"
Case "733": sPfad = "C:\Users\brandty\_Ordner3\"
Case "734": sPfad = "C:\Users\brandty\_Ordner4\"
Case "735": sPfad = "C:\Users\brandty\_Ordner5\"
Case "736": sPfad = "C:\Users\brandty\_Ordner6\"
Case "737": sPfad = "C:\Users\brandty\_Ordner7\"
Case "738": sPfad = "C:\Users\brandty\_Qual\"
Case "739": sPfad = "C:\Users\brandty\_AHB\"
Case Is  "739": GoTo NextZelle 'ungültiger Name
End Select
'Format bestimmen
If Dir(sPfad & sDateiname & ".doc")  "" Then
sEndung = ".doc"
ElseIf Dir(sPfad & sDateiname & ".docx")  "" Then
sEndung = ".docx"
ElseIf Dir(sPfad & sDateiname & ".xlm")  "" Then
sEndung = ".xlm"
ElseIf Dir(sPfad & sDateiname & ".pdf")  "" Then
sEndung = ".pdf"
Else: GoTo NextZelle 'Datei nicht vorhanden
End If
'Hyperlink setzen
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(x, 1), _
Address:=sPfad & sDateiname & sEndung, _
ScreenTip:=sPfad & sDateiname & sEndung, _
TextToDisplay:=sDateiname
End With
NextZelle:
Next x

Für die Formate bin ich nicht haftbar, die habe ich nur von dir abgeschrieben.
lg Matthias

Anzeige
AW: Hyperlinks
18.09.2015 17:52:23
Yanno
Warte...
...
...
...
Einfach Weltklasse!!! Funkt.!
Ich dachte so wie ich dies beschreibe verstehts doch keiner, einmal mehr ein grosses Lob und an den Websitebetreiber!
Bin erstaunt wie schnell und perfekt der Code gemacht wurde.
P.S. Das End 

Sub vergessen wir mal ;)
P.S.2. Gäbe es auch die Möglichkeit falls in Zelle 739863 steht, die Datei aber z.b so heisst " _
739863_in Arbeit" oder sonst ein Text noch da steht, dass dies mit dem Hyperlink auch funkt?
Vielen Vielen Dank
Gruss
Yanno
Der Code wie ich ihn habe:


Sub Hyperlinks()
Dim x As Long
Dim sDateiname As String, sPfad As String, sEndung As String
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
sDateiname = CStr(Cells(x, 1).Value)
'Ordner bestimmen
Select Case Left(sDateiname, 3)
Case "731": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\ALAW_1\"
Case "732": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\ARBAW_2\"
Case "733": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\PRAW_3\"
Case "734": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\SOP_4\"
Case "735": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\RICHT_5\"
Case "736": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\SPEZ_6"
Case "738": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\CHECK_8\"
Case "739": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\FORM_9\"
Case Is  "739": GoTo NextZelle 'ungültiger Name
End Select
'Format bestimmen
If Dir(sPfad & sDateiname & ".doc")  "" Then
sEndung = ".doc"
ElseIf Dir(sPfad & sDateiname & ".docx")  "" Then
sEndung = ".docx"
ElseIf Dir(sPfad & sDateiname & ".dot")  "" Then
sEndung = ".dot"
ElseIf Dir(sPfad & sDateiname & ".dotx")  "" Then
sEndung = ".dotx"
ElseIf Dir(sPfad & sDateiname & ".xlm")  "" Then
sEndung = ".xlm"
ElseIf Dir(sPfad & sDateiname & ".xltx")  "" Then
sEndung = ".xltx"
ElseIf Dir(sPfad & sDateiname & ".xlsx")  "" Then
sEndung = ".xlsx"
ElseIf Dir(sPfad & sDateiname & ".pdf")  "" Then
sEndung = ".pdf"
Else: GoTo NextZelle 'Datei nicht vorhanden
End If
'Hyperlink setzen
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(x, 1), _
Address:=sPfad & sDateiname & sEndung, _
ScreenTip:=sPfad & sDateiname & sEndung, _
TextToDisplay:=sDateiname
End With
NextZelle:
Next x
End Sub
Anzeige
AW: Hyperlinks
22.09.2015 11:09:16
matthias
Hallo Yanno,
selbstverständlich geht das. Mit Hilfe eines "*" als Platzhalter beim Suchen der Datei ist das schnell erledigt: 
Dim x As Long 'öffentlich
Sub Hyperlinks()
Dim sDateiname As String, sPfad As String, sEndung As String, sDateiExist As String
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
sDateiname = CStr(Cells(x, 1).Value)
'Ordner bestimmen
Select Case Left(sDateiname, 3)
Case "731": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\ALAW_1\"
Case "732": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\ARBAW_2\"
Case "733": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\PRAW_3\"
Case "734": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\SOP_4\"
Case "735": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\RICHT_5\"
Case "736": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\SPEZ_6"
Case "738": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\CHECK_8\"
Case "739": sPfad = "G:\QMS\_AHB\3 Wrst und Mech\FORM_9\"
Case Is  "739"
Call EntfHyperlink
GoTo NextZelle 'ungültiger Name
End Select
'Format bestimmen
sDateiExist = Dir(sPfad & sDateiname & "*")
If sDateiExist = "" Then
Call EntfHyperlink
GoTo NextZelle 'Datei nicht vorhanden
End If
sEndung = Mid(sDateiExist, InStrRev(sDateiExist, "."))
If sEndung = ".doc" Or _
sEndung = ".docx" Or _
sEndung = ".dot" Or _
sEndung = ".dotx" Or _
sEndung = ".xlm" Or _
sEndung = ".xltx" Or _
sEndung = ".xlsx" Or _
sEndung = ".pdf" Then
Else
Call EntfHyperlink
GoTo NextZelle 'ungültige Endung
End If
'Hyperlink setzen
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(x, 1), _
Address:=sPfad & sDateiExist, _
ScreenTip:=sPfad & sDateiExist, _
TextToDisplay:=sDateiname
End With
NextZelle:
Next x
End Sub
Sub EntfHyperlink()
With Cells(x, 1)
If .Hyperlinks.Count > 0 Then .Hyperlinks.Delete
End With
End Sub

Nun wird zuerst ermittelt ob es eine Datei im Ordner gibt die mit der 6-stelligen Nummer anfängt (sDateiExist) und davon dann die Endung ermittelt. Der Rest ist bekannt.
Bei der Bennenung deiner Dateien musst du nur aufpassen, dass nichts vor der 6-stelligen Zahl steht und kein "." verwendet wird (außer bei der Endung). Ansonsten kannst du schreiben was du willst.
Als Ergänzung habe ich das zweite Makro eingebunden. Wenn in einer Zelle ein mittlerweile ungültiger Hyperlink vorhanden ist, wird dieser entfernt damit keine "Leichen" bleiben.
lg Matthias

Anzeige
AW: Hyperlinks
23.09.2015 18:14:18
Yanno
Kommt bei mir eine Fehler (with Cells(x,1) bei diesem Code: 
Sub EntfHyperlink()
With Cells(x, 1)
If .Hyperlinks.Count > 0 Then .Hyperlinks.Delete
End With
End Sub

AW: Hyperlinks
24.09.2015 08:32:45
matthias
Hallo Yanno,
wenn es sich um den Laufzeitfehler 1004 - "Anwendungs- oder objektdefinierter Fehler" handelt, liegt das daran, dass du die Zeile Dim x As Long 'öffentlich vergessen hast. Diese MUSS oberhalb der ersten Makros stehn, so wie es auch im vorigen Post zu sehen ist. Damit ist die Variable x nicht nur auf ein Makro begrenzt, sondern kann von allen Makros innerhalb des Moduls genutzt werden. Falls ich es nicht erwähnt haben sollte: Beide Makros müssen im gleichen Modul stehen.
lg Matthias
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige