Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Hyperlinks zu abweichenden Ordnernamen

Betrifft: Hyperlinks zu abweichenden Ordnernamen von: Tim
Geschrieben am: 06.10.2014 11:24:44

Auf der Suche nach einer Lösung für mein Problem, bin ich auf dieses Forum gestoßen.
Ich habe gefühlt schon das gesamte Netz durchsucht. Allerdings weiß ich auch nicht wirklich wie ich danach suchen soll.

Und zwar habe ich eine Excel-Liste in der wir unsere Aufträge mit allen Abteilungen zur schnellen Übersicht verwalten.

Jetzt würde ich gerne per VBA automatische Hyperlinks erstellen lassen. Für die normalen Zellen habe ich dies bereits geschafft. Allerdings habe ich auch abweichende Zellenbeschriftungen zu den Ordnernamen (klingt etwas blöd)

Hier ein Beispiel:

In der Zelle steht: 333999
der Ordner heißt aber: 333999_xyz_123_zzz

Die Ordner beginnen also immer mit den 6 Ziffern, die in meiner Excel Tabelle eingetragen sind. Mit der normalen Variante das er sich die Ziffern aus der Zelle holt und daraus einen Hyperlink formt, funktioniert (natürlich) leider nicht. Jetzt ist die Frage ob es dort eine Möglichkeit gibt das er dies hinbekommt. Diese Ziffern stehen übrigens in Spalte B und ich würde dieses Makro gerne per Call-Funktion durch ein anderes Makro ausführen lassen, aber ich denke das ist nur nebensächlich.

Und mein zweites Problem ist genau umgekehrt.

Ich habe in meiner Zelle folgendes stehen

Zelle: 12345678 1234 Text
Ordnername: 12345678

Also das ich es so hinbekomme, das sich der Hyperlink nur auf die ersten 8 Ziffern der Zelle bezieht, und den Rest außer acht lässt. Diese Zellen befinden sich in der Spalte E, und auch hier würde ich gerne die Call-Funktion verwenden.

Ich hoffe ich konnte alles verständlich erklären, und mir kann jemand helfen.

Ach und ich benutze Excel 2007.

MfG Tim K.

  

Betrifft: AW: Hyperlinks zu abweichenden Ordnernamen von: fcs
Geschrieben am: 06.10.2014 13:17:40

Hallo Tim,

mit entsprechenden Prüfungen, ob ein Verzeichnis vorhanden ist, das mit der Auftrags-Nr. beginnt bzw. ein Verzeichnis mit den ersten 8 Zeichen vorhanden ist, sollte es funktionieren.

Gruß
Franz

Sub HyperlinksOrdner()
  Call HyperlinksOrdnerSpalteB
  Call HyperlinksOrdnerSpalteE
End Sub

Sub HyperlinksOrdnerSpalteB()
  'Hyperlinks zu Auftragsordnern in Spalte B einfügen
  Dim strText As String
  Dim wks As Worksheet
  Dim Zeile As Long
  Dim strPfad As String, strDir As String, strLink As String
  
  strPfad = "Y:\Test\Auftraege" 'Basisverzeichnis für Aufträge - anpassen!
  Set wks = ActiveWorkbook.Worksheets("Tabelle2") 'Tab-Name anpassen!!
  
  With wks
  For Zeile = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row 'Startzeile ggf. anpassen
      With .Cells(Zeile, 2)
        If .Hyperlinks.Count > 0 Then
          .Hyperlinks(1).Delete
        End If
        strText = .Text
      End With
      If strText <> "" Then
      strLink = ""
      strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
      If strDir <> "" Then
        strLink = strPfad & Application.PathSeparator & strText
      Else
        strText = strText & "*"
        strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
        If strDir <> "" Then
          strLink = strPfad & Application.PathSeparator & strDir
          strText = strDir
        End If
      End If
      If strLink = "" Then
        MsgBox "In Zeile " & Zeile & " kein Verzeichnis zu Auftrag """ _
            & strText & """ gefunden", vbOKOnly, "Hyperlinks Spalte B"
      Else
        wks.Hyperlinks.Add anchor:=.Cells(Zeile, 2), Address:=strLink, _
            ScreenTip:="Auftragsordner: " & strText
      End If
      End If
  Next
  End With
End Sub

Sub HyperlinksOrdnerSpalteE()
  'Hyperlinks zu Auftragsordnern in Spalte E einfügen
  Dim strText As String
  Dim wks As Worksheet
  Dim Zeile As Long
  Dim strPfad As String, strDir As String, strLink As String
  
  strPfad = "Y:\Test\Auftraege" 'Basisverzeichnis - anpassen!!
  Set wks = ActiveWorkbook.Worksheets("Tabelle2") 'Tab-Name anpassen
  
  With wks
  For Zeile = 2 To .Cells(.Rows.Count, 5).End(xlUp).Row 'Startzeile ggf. anpassen
      With .Cells(Zeile, 5)
        If .Hyperlinks.Count > 0 Then
          .Hyperlinks(1).Delete
        End If
        strText = .Text
      End With
      If strText <> "" Then
        strLink = ""
        strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
        If strDir <> "" Then
          strLink = strPfad & Application.PathSeparator & strText
        Else
          strText = Left(strText, 8)
          strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
          If strDir <> "" Then
            strLink = strPfad & Application.PathSeparator & strDir
          End If
        End If
        If strLink = "" Then
          MsgBox "In Zeile " & Zeile & " kein Verzeichnis zu Auftrag """ _
            & strText & """ gefunden", vbOKOnly, "Hyperlinks Spalte E"
        Else
          wks.Hyperlinks.Add anchor:=.Cells(Zeile, 5), Address:=strLink, _
            ScreenTip:="Auftragsordner: " & strText
        End If
      End If
  Next
  End With
End Sub



  

Betrifft: AW: Hyperlinks zu abweichenden Ordnernamen von: Tim
Geschrieben am: 06.10.2014 13:58:01

Das ist überragend Franz!
Danke!!

Allerdings habe ich zwei (und ein kleines drittes) Probleme, die ich mit meinen bescheidenen VBA-Kenntnissen (wenn man sie schon Kenntnisse nennen kann) nicht gelöst bekomme.

Zur Erklärung

Ich habe eine Schaltfläche mit dem Namen "Neuer Auftrag"
Dieser löst ein Makro aus, welches am Ende der Tabelle eine neue Zeile anlegt.
Daraufhin wird wiederrum per Call-Funktion eine Abfrage gestartet wo ich eben diese Nummern eingebe (per msgbox).
Nachdem ich die Nummer in Spalte B dann eingegeben habe würde ich wiederum per Call-Funktion, nur für diese Zelle, nicht für die gesamte Spalte die Abfrage in dem vorgegebenem Verzeichnis starten.

Daraufhin erscheint erneut eine msgbox in der ich den Wert für Spalte E eintrage, wodurch ich dann wiederum die Call-Funktion für die Abfrage in Spalte E starten möchte. Das dann auch eben nur für diese eine Zelle in Spalte E, nicht für die gesamte Spalte.

Ich hoffe du verstehst mein Anliegen.

Mein zweites Problem ist wahrscheinlich eher Blödheit meinerseits. Das Makro für Spalte E fragt bei mir Spalte C ab. Ich kann allerdings nicht daraus erkennen wo in dem Code die Spalte angegeben ist.

Und mein kleines drittes Problem ist, das wenn er die Abfrage für die Spalte B durchgeführt hat, er die Werte nicht mehr zentriert, sondern unten rechts in die Ecke packt.

Ich hoffe ich nehme dadurch nicht allzu viel deiner Zeit in Anspruch, und danke nochmal.


  

Betrifft: AW: Hyperlinks zu abweichenden Ordnernamen von: Tim
Geschrieben am: 06.10.2014 14:03:04

Die Abfrage startet er nun doch in Spalte E. Doch auch dort ändert er die Formatierung. Die Acht ziffern stehen in der oberen Zeile, und der Rest in der darunter (Automatischer Zeilenumbruch)


  

Betrifft: AW: Hyperlinks zu abweichenden Ordnernamen von: fcs
Geschrieben am: 06.10.2014 16:51:12

Hallo Tim,

wenn nur immer eine Zelle/Zeile mit einem Hyperlink versehen werdne soll, dann kann man die Makros etwa wie folgt aufbauen. Die Zelle, die den Hyperlink bekommen soll, wird dabei als Parameter übergeben.

Für die Änderung der Formatieung hab ich keine 100% Erklärung.
Das Einfügen eines Hyperlinks verändert jedoch ggf. die Schriftart/Farbe/Schriftgöße/Unterstreichung im Zellformat. Wenn das automatische Hyperlink-Format nicht gefällt, dann muss man nachträglich umformatieren.

Sub HyperlinksOrdner()
  Dim strEingabe As String, Zeile As Long
  Zeile = ActiveCell.Row
  
  strEingabe = InputBox("Bitte Unterordner für Auftrag in Spalte B eingaben", _
      "Ordner Spalte B")
  If strEingabe <> "" Then
    ActiveSheet.Cells(Zeile, 2) = "'" & strEingabe
    Call HyperlinksOrdnerSpalteB(Zelle:=ActiveSheet.Cells(Zeile, 2))
  End If
  strEingabe = InputBox("Bitte Unterordner für Auftrag in Spalte E eingaben", _
      "Ordner Spalte E")
  If strEingabe <> "" Then
    ActiveSheet.Cells(Zeile, 2) = "'" & strEingabe
    Call HyperlinksOrdnerSpalteE(Zelle:=ActiveSheet.Cells(Zeile, 5))
  End If
End Sub

Sub HyperlinksOrdnerSpalteB(Zelle As Range)
  'Hyperlinks zu Auftragsordnern in Spalte B einfügen
  Dim strText As String
  Dim wks As Worksheet
  Dim strPfad As String, strDir As String, strLink As String
  
  strPfad = "Y:\Test\Auftraege" 'Basisverzeichnis für Aufträge - anpassen!
  Set wks = Zelle.Parent 'Tab-Name anpassen!!
  
  With wks
      With Zelle
        If .Hyperlinks.Count > 0 Then
          .Hyperlinks(1).Delete
        End If
        strText = .Text
      End With
      If strText <> "" Then
        strLink = ""
        strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
        If strDir <> "" Then
          strLink = strPfad & Application.PathSeparator & strText
        Else
          strText = strText & "*"
          strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
          If strDir <> "" Then
            strLink = strPfad & Application.PathSeparator & strDir
            strText = strDir
          End If
        End If
        If strLink = "" Then
          MsgBox "In Zeile " & Zelle.Row & " kein Verzeichnis zu Auftrag """ _
              & strText & """ gefunden", vbOKOnly, "Hyperlinks Spalte B"
        Else
          wks.Hyperlinks.Add anchor:=Zelle, Address:=strLink, _
              ScreenTip:="Auftragsordner: " & strText
        End If
        With Zelle 'Formatierung anpassen
          .HorizontalAlignment = xlCenter 'xlLeft xlRight
          .VerticalAlignment = xlCenter 'xlTop  xlBottom
          With .Font
            .Size = 8
            .Name = "Calibri"
          End With
          .WrapText = False
        End With
      End If
  End With
End Sub

Sub HyperlinksOrdnerSpalteE(Zelle As Range)
  'Hyperlinks zu Auftragsordnern in Spalte E einfügen
  Dim strText As String
  Dim wks As Worksheet
  Dim strPfad As String, strDir As String, strLink As String
  
  strPfad = "Y:\Test\Auftraege" 'Basisverzeichnis - anpassen!!
  Set wks = Zelle.Parent 'Tab-Name anpassen
  
  With wks
      With Zelle
        If .Hyperlinks.Count > 0 Then
          .Hyperlinks(1).Delete
        End If
        strText = .Text
      End With
      If strText <> "" Then
        strLink = ""
        strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
        If strDir <> "" Then
          strLink = strPfad & Application.PathSeparator & strText
        Else
          strText = Left(strText, 8)
          strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
          If strDir <> "" Then
            strLink = strPfad & Application.PathSeparator & strDir
          End If
        End If
        If strLink = "" Then
          MsgBox "In Zeile " & Zelle.Row & " kein Verzeichnis zu Auftrag """ _
            & strText & """ gefunden", vbOKOnly, "Hyperlinks Spalte E"
        Else
          wks.Hyperlinks.Add anchor:=Zelle, Address:=strLink, _
            ScreenTip:="Auftragsordner: " & strText
        End If
        
        With Zelle 'Formatierung anpassen
          .HorizontalAlignment = xlCenter 'xlLeft xlRight
          .VerticalAlignment = xlCenter 'xlTop  xlBottom
          With .Font
            .Size = 8
            .Name = "Calibri"
          End With
          .WrapText = False
        End With
      End If
  End With
End Sub



  

Betrifft: AW: Hyperlinks zu abweichenden Ordnernamen von: Tim
Geschrieben am: 07.10.2014 08:28:37

Mit ein paar Anpassungen ist es jetzt nahezu perfekt! Ich danke dir echt unglaublich dafür!! Auch die Formateriung (zentriert) funktioniert einwandfrei. Die Formatierung von Hyperlinks habe ich vorher eingestellt, und ändere sie per Call-Befehl ggf. eh noch einmal ab.

Mein einziges Problem was ich nun noch hatte war, das er die Zahlen in Spalte A&B (A nun auch weil ich dieses Makro so klasse finde das ich es nun auch für die Spalte übernommen habe wo Zellenwert & Ordnername gleich sind) als Text auswirft, und mir ein kleines Dreieck in die Ecke stellt, wo ich diesen Text dann in eine Zahl umwandeln kann. Das Problem was sich dadurch ergab, war dass er diesen Text dann nicht in meine Sortierung mit aufnimmt, wenn ich die Aufträge z.B. nach aufsteigender Nummer sortieren lasse.

Das habe ich dann, falls jemand mit dem selben Problem auf diesen Thread trifft, mit dieser Funktion ausgemerzt:

Sub TextumwandlungA()
  With ActiveCell.Range("A1")
    .NumberFormat = "General"
    .Value = .Value
  End With
End Sub
welche ich dann per Call-Befehl nach dem Ausführen des Makros, für die Hyperlinkerstellung ausführen lasse. Somit ist meine Tabelle nun perfekt. Zumindest für mich :) Noch einmal ein rießiges Danke für die tolle Hilfe! :)


  

Betrifft: AW: Hyperlinks zu abweichenden Ordnernamen von: Tim
Geschrieben am: 06.10.2014 14:35:17

Entschuldigung für die Mehrfachposts, allerdings versteh ich einen Fehler nicht so ganz den er mir auswirft.

Und zwar habe ich das offensichtliche nun auch erkannt, das ich für Spalte E nicht nach einem E suchen musste sondern nach einer 5.

Allerdings wenn ich nun mein Verzeichnis in den Code für Spalte E eintrage, erscheint der Fehler

Laufzeitfehler '52':

Dateiname oder -nummer falsch

und mir wird die Zeile

 strDir = Dir(strPfad & Application.PathSeparator & strText, vbDirectory)
Gelb hinterlegt. Wenn ich jedoch die Spalte von 5 auf 4 ändere funktionierts...


 

Beiträge aus den Excel-Beispielen zum Thema "Hyperlinks zu abweichenden Ordnernamen"