Bildauswahl per Makro startet nicht im vorgegebenen Pfad
22.12.2023 14:30:33
Martin
ich hatte ein ähnliches Problem vor einigen Tagen und im Forum wurde mir dann empfohlen mit Chdrive und CHdir zu arbeiten.
Das will dieses mal irgendwie nicht funktionieren. Kann bitte einer mal auf den Code schauen und mir sagen, warum das Auswahlfenster für für die Bildauswahl nicht bei "folderPath" beginnt? Ich starte bei der Auswahl immer wieder bei Dokumente.
Das Makro funktioniert sonst reibungslos. Danke euch vorab!
Gruß
Martin
Sub Wareneingangsbild()
Dim startSheet As Worksheet
Dim productSheet As Worksheet
Dim serialNumber As String
Dim targetFolder As String
Dim folderPath As String
Dim foundCell As Range
Dim selectedFile As Variant
Dim img As Shape
' Arbeitsblätter definieren
Set startSheet = ThisWorkbook.Sheets("Start")
Set productSheet = ThisWorkbook.Sheets("Produktvarianten")
' Die 12NC Nummer aus Zelle C8 des "Start"-Reiters holen
targetFolder = startSheet.Range("C8").Value
' Die Serialnummer aus Zelle C6 des "Start"-Reiters holen
serialNumber = startSheet.Range("C6").Value
' Suche nach der 12NC Nummer in Spalte B des "Produktvarianten"-Reiters
Set foundCell = productSheet.Columns("B:B").Find(What:=targetFolder, LookIn:=xlValues)
If Not foundCell Is Nothing Then
' Pfad zum gefundenen Ordner aus Spalte C der gleichen Reihe erhalten
folderPath = productSheet.Cells(foundCell.Row, 3).Value & "\" & serialNumber & "\"
MsgBox folderPath
ChDrive (Left(folderPath, 1)) 'Hier habe ich es auch mit ChDrive "L:" ausprobiert, hat nicht geklappt
ChDir folderPath
' Pfad mit der Serialnummer durchsuchen
If InStr(folderPath, serialNumber) > 0 Then
'Warenausgangsbild auswählen
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Bitte das Warenausgangsfoto vom Aufkleber mit der BID Nummer auswählen!"
.Filters.Add "Bilder", "*.jpg; *.jpeg; *.png; *.gif; *.bmp", 1 'Nur Bildformate zulassen
'Überprüfen, ob OK geklckt wurde
If .Show = -1 Then
selectedFile = .SelectedItems(1)
Else
MsgBox "Kein Warenausgangsbild ausgewählt!"
End If
End With
' Bild einfügen
On Error Resume Next
Set img = ActiveSheet.Shapes.AddPicture(selectedFile, msoFalse, msoCTrue, Range("L3").Left, Range("L3").Top, Range("Q17").Left - Range("L3").Left, Range("Q17").Top - Range("L3").Top)
On Error GoTo 0
If img Is Nothing Then
MsgBox "Bild konnte nicht eingefügt werden."
End If
Else
MsgBox "Die Serialnummer wurde nicht gefunden"
End If
End If
End Sub