Bilder vertikal einfügen
11.07.2017 07:44:43
Joline
ich bin mal wieder beim Einfügen von Bildern.
Ich füge über einen Command Button mehrere Bilder auf einem Tabellenblatt ein, um diese dann sortiert auf ein anderes Tabellenblatt zu bringen. Am liebsten würde ich direkt an die richtige Stelle einfügen, aber das habe ich bisher nicht hinbekommen.
Das andere schon, solange ich die Bilder horizontal auf meinem Zieltabellenblatt anordne.
Nun möchte ich aber für eine bestimmte Anwendung meine Bilder vertikal anordnen, wie geht das/ warum klappt es bei dem Code nicht?
Oder gibt es insgesamt eine einfachere Lösung?
Die Auswahl der Bilder soll flexibel bleiben, da der Speicherort variiert.
Vielen Dank und liebe Grüße
Joline
Private Sub CommandButton2_(Click)
Dim bildQuelle As Variant
Dim limit As Integer
Dim index As Integer
Dim hoehe As Integer
Dim hoeheReihe As Integer
Dim abstand As Integer
Dim abstandRand As Integer
Dim abstandBilder As Integer
Dim bildBreite As Integer
Dim bildHoehe As Integer
Dim arrShape() As Shape 'dynamisches Datenfeld - deswegen Klammern leer
Application.ScreenUpdating = False
bildBreite = Worksheets("Einstellungen").Range("C51").Value
bildHoehe = Worksheets("Einstellungen").Range("C52").Value
hoeheReihe = Worksheets("Einstellungen").Range("C56").Value
abstandRand = Worksheets("Einstellungen").Range("C54").Value
abstandBilder = Worksheets("Einstellungen").Range("C58").Value + bildHoehe
bildQuelle = Application.GetOpenFilename(Title:="Bitte zwei Bilder auswählen:", _
FileFilter:="Bilder,*.jpg", MultiSelect:=True)
'MsgBox bildQuelle(1)
If TypeName(bildQuelle) = "Boolean" Then
GoTo Fehler1
End If
If UBound(bildQuelle) > 2 Then
limit = 2
MsgBox "Es wurden mehr als 2 Datein ausgewählt"
Else
limit = UBound(bildQuelle)
End If
Worksheets("Einstellungen").Activate
abstand = abstandRand
hoehe = hoeheReihe
ReDim arrShape(1 To limit) 'Dimensionierung dynamischer Datenfelder
For index = 1 To limit
Set arrShape(index) = ActiveSheet.Shapes.AddPicture _
(bildQuelle(index), True, True, abstand, hoehe, bildBreite, bildHoehe)
hoehe = hoeheReihe + abstandBilder
Next index
If MsgBox("Bilder in richtige Reihenfolge sortieren?", _
vbOKOnly, "Bilder einfügen") = vbOK Then
With Worksheets("ErgebnisZusammen (zum Drucken)")
.Activate
For index = 1 To limit
arrShape(index).Copy
Select Case index
Case 1: .Paste .Range("S35")
Case 2: .Paste .Range("S20")
End Select
Next
End With
Else
End If
Application.ScreenUpdating = True
Exit Sub
Fehler1:
Application.ScreenUpdating = True
MsgBox "Einfügen abgebrochen!"
End Sub