Formatierung bei Makro beibehalten
12.01.2016 09:58:25
Tim
ich habe vor einiger Zeit eine Excel-Liste für die Übersicht unserer Aufträge erstellt und mir in diesem klasse Forum helfen lassen:
https://www.herber.de/forum/archiv/1384to1388/t1385030.htm#1385085
Hier der Link zum damaligen Thema
Ich habe also eine Abfrage in der dann automatisch Hyperlinks hinterlegt werden.
Nun hat sich aber nach einiger Zeit herausgestellt das nicht jeder so mit der Liste arbeitet wie er es soll...
Somit habe ich jetzt die Funktion eingefügt, das mit einem Klick alle Hyperlinks erstellt werden.
Das Funktioniert auch soweit. Allerdings sind die Zellen in denen die Auftragsnummer steht entweder in Grün-mit schwarzer Schrift, oder in Rot-mit weißer Schrift formatiert.
Wenn ich nun allerdings mein Makro drüber laufen lasse, ändert er alle Schriftfarben zu schwarz.
Dies kann man dann allerdings nur noch bedingt lesen. Die Zellenfarbe von Rot auf ein Orange o.ä. zu ändern gibt wieder nur Probleme mit unseren Alteingesessenen...
Kann mir jemand helfen, wie er die Formatierung beibehalten kann?
Sub AlleHyperlinksOrdnerSpalteA()
'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 = "P:\KONSTRUK\Fertigungsaufträge\" 'Basisverzeichnis für Aufträge - anpassen!
Set wks = ActiveWorkbook.Worksheets("Reparatur") 'Tab-Name anpassen!!
With wks
For Zeile = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row 'Startzeile ggf. anpassen
With .Cells(Zeile, 1)
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 "Zu Auftrag """ & strText & """ konnte kein Verzeichnis gefunden werden", _
vbOKOnly, "Hyperlink Fertigungsauftragsordner"
Else
wks.Hyperlinks.Add anchor:=.Cells(Zeile, 1), Address:=strLink, _
ScreenTip:="Auftragsordner: " & strText
End If
End If
Next
End With
End Sub
Hier mein Makro.