mehrere Bilder in bestimmter Reihenfolge einfügen
23.06.2017 08:22:58
Joline
ich schlage mich seit einigen Tagen mit einer fiesen kleinen Problemstellung rum. Ich möchte via Command-Button Bilder einfügen und diese nicht in der Reihenfolge der Dateinamen anordnen (da mehrere Leute das Auswertesystem nutzen ist jede Änderung der Dateinamen eine zusätzliche Fehlerquelle, die ich vermeiden möchte). Ich habe es über mehrere Wege versucht die Bilder über das Makro1 (recte) einzufügen und über ein Makro2 (kursiv) umzusortieren. Im einzelnen Funktionieren beide Makros auch problemlos, aber leider nicht zusammen.
Mein erster Ansatz war über die Call Funktion das 2 Makro aufzurufen, das Makro 1 (gespeichert auf Tabellenblatt) lief problemlos durch, das Makro2 (gespeichert im Modul) aber nicht, das selbe gilt für die Application. Run Variante (Ansatz 2).
Mein dritter Ansatz ist nun das Makro 2 direkt ins Makro 1 zu schreiben (Makro 3). Makro 3 läuft auch vollständig durch, aber leider werden die ausgeschnittenen Bilder nicht auf dem im Code benannte Tabellenblatt eingefügt, sondern auf dem Tabellenblatt auf dem der Command-Button liegt und auf dem auch das Makro 3 geschrieben ist, die Ablagezelle stimmt aber wieder.
Hier für euch mein Code, möglicherweise hat einer von euch eine Idee, woran es liegen könnte. Oder einen ganz anderen Ansatz, ich bin mittlerweile etwas Ratlos...
Das Tabellenblatt was am Ende angezeigt werden soll wird leider auch nicht aufgerufen, ist aber weniger schlimm als mein Bildchaos.
Makro 3:
Private Sub CommandButton3_Click()
Dim bildQuelle As Variant
Dim limit 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
Application.ScreenUpdating = False
bildBreite = Worksheets("Einstellungen").Range("E2").Value
bildHoehe = Worksheets("Einstellungen").Range("E3").Value
hoeheReihe = Worksheets("Einstellungen").Range("E7").Value
abstandRand = Worksheets("Einstellungen").Range("E5").Value
abstandBilder = Worksheets("Einstellungen").Range("E9").Value + bildBreite
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
Dim index As Integer
For index = 1 To limit
ActiveSheet.Shapes.AddPicture _
bildQuelle(index), True, True, abstand, hoehe, bildBreite, bildHoehe
abstand = abstand + abstandBilder
Next index
'Call Modul1.ImportBild
If MsgBox("Bilder in richtige Reigenfolge sortieren?", vbOKOnly, "Bilder einfügen") = _
vbOK Then
Dim Bild1 As Variant
Dim Bild2 As Variant
For Each Bild1 In Sheets("Einstellungen").Shapes
If Not Intersect(Sheets("Einstellungen").Range("D70:F70"), Bild1.TopLeftCell) Is _
Nothing Then
Bild1.Copy
Worksheets("ErgebnisZusammen (zum Drucken)").Paste Range("B25")
End If
Next
For Each Bild2 In Sheets("Einstellungen").Shapes
If Not Intersect(Sheets("Einstellungen").Range("A70:C70"), Bild2.TopLeftCell) Is _
Nothing Then
Bild2.Copy
Worksheets("ErgebnisZusammen (zum Drucken)").Paste Range("L25")
End If
Next
Else
End If
'Application.Run index:=ImportBild
'Workbooks.Open Filename:="S:\KV\Kv1\Prüfprogramme\Werksprüfungen\KV_WP05_Spritzgebäck\vorü _
_
_
bergehende Hauptvorlage Spritzgebäck_2 Ebenen.xlsm"
'Application.Run "vorübergehende Hauptvorlage Spritzgebäck_2 Ebenen.xlsm!ImportBild"
Exit Sub
Fehler1:
MsgBox "Einfügen abgebrochen!"
Application.ScreenUpdating = True
Worksheets("ErgebnisZusammen (zum Drucken)").Activate
End Sub