In eine Excel-Vorlage (max 4 Bilder) werden über den Dateimanger bis zu 4 Bilder markiert und automatisch eingefügt, einschl. schreiben des Dateinamens in eine bestimmte Zelle. Das Formular wird aus Access aufgerufen, eine Schadennummer eingetragen und das Unterverzeichnis mit dieser Schadensnummer ausgewählt.
Im Prinzip funktioniert alles, wobei ein Fehler sein muss, weil ich bei den ArrBereichen einen doppelt hinterlegen musste, damit 4 Bilder auch eingefügt werden.
Vielleicht kann jemand helfen ?
Gruss Jürgen
Code:
Sub BilderEinfuegen_neu()
Dim bytBild As Byte
Dim arrBereiche()
Dim StOrdner As String
Dim SNZelle As Strings
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