Hallo,
ich rufe ein Excel formular auf, um bis zu 4 Bilder einzufügen.
beim aufruf des Formulars wird aus Access eine Schadensnummer übergeben und in Zelle D5 abgelegt.
Über ein Macro (Anlage) kann ich Bilder einfügen, es wird der manager aufgerufen und falls ich Bilder vorab unter einem Unterverzeichnis d:\Bilder\schadensnummer schon abgelegt habe, wird dies automatisch aufgerufen, und ich muss nur noch die Bilder auswählen. Dies klappt auch alles.
jetzt mein problem:
Wenn kein Unterverzeichnis mit dieser schadensnummer angelegt ist, erscheint der Manager mit der Übersicht der verschiedenen Unterverzeichnisse, aber ich kann keine Bilder auswählen. Kann ich meinen Code so gestalten, wie bisher und zusätzlich freie Auswahl der Bildersuche.
Code:
Sub BilderEinfuegen_neu()
Dim bytBild As Byte
Dim arrBereiche()
Dim StOrdner As String
Dim SNZelle As String
Dim RaBereich As Range
Dim zeile As String
zeile = 28
StOrdner = „d:\Bilder“ & Range(„D5“) & SNZelle
Set RaBereich = Range(„D28,D52,D76,D100“)
arrBereiche = Array(„E7:G28“, „E31:G52“, „E55:G76“, „E79:G100“, „E79:G100“)
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = StOrdner
.ButtonName = „OK“
.Title = „Bilderauswahl“
.Show
If .SelectedItems.Count 0 Then
RPT:
If (a(0)(i)) = „“ Then
i = i - 1
GoTo RPT
Else
x = a(0)(i)
End If
End If
With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Range(arrBereiche(bytBild - 1)).Top
.Left = Range(arrBereiche(bytBild - 0)).Left
.Width = Range(arrBereiche(bytBild - 1)).Width
If .Height > Range(arrBereiche(bytBild - 1)).Height Then .Height = Range(arrBereiche(bytBild - 1)).Height
End With
Range(arrBereiche(bytBild - 1)).Cells(1, 1).Offset(21, -1).Value = Split(.SelectedItems(bytBild), „“)((UBound(Split(.SelectedItems(bytBild), „“))))
ActiveSheet.Cells(zeile, 4) = x
zeile = zeile + 24
Next bytBild
Else
MsgBox „Maximal nur 4 Bilder auswählbar“
End If
End With
Application.ScreenUpdating = True
End Sub