Excel: Pfad mittels VBA ändern

Question

Hallo zusammen

Ich erstelle momentan eine Excel-Vorlage in welche automatisch die eingescannte Unterschrift des entsprechenden Mitarbeiters eingefügt bzw. der Link zu einer bereits eingefügten Grafik entsprechend abgeändert werden soll. Die Unterschriften (.jpg) sind gleich benennt wie die entsprechenden Benutzernamen (Application.UserName). Somit entspricht der Link zum Ordner mit den Unterschriften im Laufwerk + Application.UserName + die Endung “.jpg“ dem Link zur Unterschrift.

Wie kann man machen, dass der Link zur eingefügten Grafik beim Öffnen der Vorlage automatisch angepasst wird?

Danke für eure Hilfe.

Liebe Grüsse
donjuandan

Answer 1

Hallo,

das könnte z.B. so aussehen:

Sub Beispiel()

Dim pfad As String

pfad = "C:\Eigene Dateien\" & Application.UserName & ".jpg"

MsgBox pfad

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.

Danke für Deine Antwort.

Leider konnte sie mein Problem nicht lösen. Ich suche nach einer Möglichkeit den Pfad zu einer bereits eingefügten Grafik wie oben beschrieben zu ändern. Alternativ könnte man die bestehende Grafik via VBA auch löschen und jeweils neu einfügen.

Liebe Grüsse
donjuandan

Answer 3

Hallo,

da du die Unterschrift ja als Bild einfügst wird es mit der Datei abgespeichert. Es nutzt also nichts nur den Pfad zu ändern. Bevor du die neue Unterschrift einfügst, musst du das Bild mit der alten Unterschrift löschen.

Da das alles automatisch bei Öffnen der Datei geschehen, gehört der folgende Code in das VBA-Projekt der Arbeitsmappe:

Private Sub Workbook_Open()
Dim Objekt As Object
Dim pfad As String

'ggf. vorhandene Grafiken löschen
For Each Objekt In Sheets("Tabelle1").Shapes
If Mid(Objekt.Name, 1, 6) = "Grafik" Then
Objekt.Delete
End If
Next

'Pfad für das Bild
pfad = "C:\Eigene Dateien\" & Application.UserName & ".jpg"

'Bild einfügen
With Sheets("Tabelle1")
.Pictures.Insert (pfad)
With .Pictures(.Pictures.Count)
'mit oberer linker Ecke in Zelle B10
.Top = Range("B10").Top
.Left = Range("B10").Left
'Grafik wird skaliert
.ShapeRange.ScaleWidth 0.31, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.31, msoFalse, msoScaleFromTopLeft
End With
End With

End Sub

Den Code musst du natürlich noch auf deine Gegebenheiten anpassen, insbesondere den Namen der Tabelle, den Pfad und auch die Zelle in der das Bild mit der Unterschrift eingefügt werden muss.
Ich gehe auch davon aus, dass außer der Unterschrift keine anderen Bilder in das Arbeitsblatt eingefügt wurden.

Gruß

M.O.

Answer 4

Danke nochmals für Deine Antwort.

Leider funktioniert der Code bei mir nicht. Ich habe ihn unter „DieseArbeitsmappe“ eingefügt und entsprechend angepasst (Pfad). Beim Ausführen erscheint die Meldung „Laufzeitfehler 1004: Anwendungs- oder objektdefinierter Fehler“.

Ich habe noch einen weiteren Code getestet, bei welchem dieselbe Meldung erscheint:

Sub test()
Dim strPfad As String
strPfad = "I:\test\Unterschriften\" & Application.UserName & ".jpg"
ActiveSheet.Shapes.AddPicture((strPfad), False, True, 100, 200, 400, 200).Select
End Sub

Kann es daran liegen, dass das entsprechende Laufwerk in einem Netzwerk ist?

Liebe Grüsse
donjuandan

Answer 5

Hallo,

wie heißt denn die Tabelle, in die die Unterschrift eingefügt werden soll? Hast du den Namen in meinem geposteten Code (hier heißt das Blatt Tabelle1) angepasst.
In welcher Zeile wird denn der Fehler angezeigt (gelb hinterlegte Zeile)?

An dem Netzwerkpfad dürfte es eigentlich nicht liegen (wenn dieser vom Rechner her erreichbar ist).

Gruß

M.O.

Answer 6

Die Tabelle heisst bei mir ebenfalls Tabelle1.

Die erwähnte Fehlermeldung tritt auf, wenn ich den Code manuell starte (dabei wird keine Zeile gelb markiert). Wenn ich die Datei schliesse und wieder öffne erscheint die Meldung:

"Die Insert-Methode des Pictures-Objektes konnte nicht ausgeführt werden."

Folgende Zeile wird gelb markiert:

.Pictures.Insert (pfad)

Liebe Grüsse
donjuandan

Answer 7

Hallo,

ich würde mal probieren, ob das Bild von einem lokalen Pfad her eingefügt wird. Bei mir klappt das Einfügen auch aus einem Netzwerkpfad her.

Hast du mal nachgeschaut, ob das Netzwerklaufwerk auf dem Rechner existiert, der Netzlaufwerkbuchstabe richtig ist etc?

Gruß

M.O.

Answer 8

Auch aus dem lokalen Laufwerk wird die Datei nicht eingefügt.

Wir arbeiten mit Citrix XenApp. D.h. Excel ist nicht auf meinem PC lokal installiert. Vielleicht liegt es daran.

Ich werde deshalb heute schauen ob der Code bei mir zuhause funktioniert.

Liebe Grüsse
donjuandan

Answer 9

Guten Morgen

Nachdem ich heute alles nochmals angeschaut habe, ist mir aufgefallen, dass mir ein dummer Fehler unterlaufen ist. Application.UserName gibt den Benutzernamen folgendermassen aus: Nachname Vorname. Die Unterschriften waren bei mir mit "Vorname Nachname" benennt.

Dein Code funktioniert nun einwandfrei. Herzlichen Dank!

Liebe Grüsse
donjuandan

Answer 10

Hallo,

freut mich dass es doch noch geklappt hat. Und danke für die Rückmeldung.

Gruß

M.O.