Ich habe die Aufgabe über 1000 Bilder einfügen. Pro Blatt wird immer ein 1 Bild hinzugefügt. Jedes Blatt hat seinen Überschrift. Der Überschrift pro Blatt ändert sich minimal.
Am ende werden es über 100 Exceldokumente die jeweils mindestens 10-15 Blätter haben werden.
Ich würde gerne eine Excel Vorlage erstellen und anhand dieses nur die Bilder ändern und die Überschrift minimal anzupassen.
DIe Excelfunktion "bild ändern" ist sehr schlecht da es sehr zeitaufwendig ist.
Gibt es irgendwelche Möglichkeit das alles mit einem Skript zu machen? Wo ich einfach den Pfad des Bildes jeweils ändern kann und so nicht soviel Zeit verlieren?
Leider habe ich null Kenntnisse in VBA. Habt ihr eine Vorlage für mich veilleicht?
Vielen Dank!
Gruß Steffen
Hallo Steffen,
könntest Du eine kleine Beispieldatei hochladen und folgende Fragen beantworten:
- wie werden Texte und Bilder zugeordnet
- sollen die Bilder bei Eingabe der Text eingefügt werden, oder werden die Bilder in die Dateien mit dem fertigen Text eingefügt
- wie ändern sich die Überschriften
Mache Dich mit den Grundlagen von VBA vertraut:
- öffnen des Editors (z.B. ALT-F11)
- Tests mit sehr einfachen Codes ("Hello World")
- Einzelschritt-Modus
Youtube sollte einiges anbieten.
mfg
Hallo Steffen,
Poste bitte keine Datei wo ein Bild drin ist, das hilft nicht. Du könntest aber folgendes vorbereiten:
- zeichne ein Makro auf, wenn Du ein Bild einfügst. Siehe dazu in unserem Beispielbereich mein Beitrag zur Arbeit mit dem Makrorekorder
- schreibe in ein Blatt eine Liste der Bilder, die in diese Datei kommen sollen
ein aufgezeichnetes Makro zum Erstellen eines neuen Blattes und einfügen eines Bildes könnte so aussehen:
Code:
Sub Makro1()
'
' Makro1 Makro
'
'
Sheets.Add After:=ActiveSheet
ActiveSheet.Pictures.Insert("C:\Temp\jahr1.png").Select
End Sub
Wenn Du für jedes Bild ein neues Excelblatt nimmst, dann macht man eine Schleife drumherum, die dann die Dateien entsprechend der Bilderliste einfügt.
| Arbeitsblatt mit dem Namen 'Tabelle1' |
| A |
| 1 | C:\Temp\jahr1.png |
| 2 | C:\Temp\jahr2.png |
| 3 | |
| Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016 |
| Diese Tabelle wurde mit Tab2Html (v2.6.2) erstellt. ©Gerd alias Bamberg |
Das angepasste makro würde dann so aussehen, allerdings noch ohne Überschriften usw. und das Bild klemmt auch oben links ...
Code:
Option Explicit
Sub Makro1()
'Variablendeklaration - Integer
Dim iCnt%
'Startwert Schleifenzaehler setzen - hier fuer Zeile 1
iCnt = 1
'Schleife ueber alle Bildeintraege bis zur ersten leeren Zelle
Do While Sheets("Tabelle1").Cells(iCnt, 1).Value <> ""
'Neues Blatt am Ende einfuegen
Sheets.Add After:=ActiveSheet
'Bild entsprechend Liste oben links einfuegen
ActiveSheet.Pictures.Insert(Sheets("Tabelle1").Cells(iCnt, 1).Value).Select
'Schleifenzaehler hochsetzen
iCnt = iCnt + 1
'Ende Schleife ueber alle Bildeintraege bis zur ersten leeren Zelle
Loop
End Sub
Mappe siehe Anhang
Danke das ist schon besser. Wie kann ich es zentrieren und ein Überschrift hinzufügen?
Sorry wenn ich nochmal nerve. Ich würde es gerne so haben. Das pro Blatt 3 Bilder hinzugefügt werden. Die alle durchnummeriert sind z.b habe ich im verzeichnis bilder mit 0001.png bis 0100.png.
und es soll jetzt auf erste blatt dann 0001.png - 0003.png reingeladen werden mittig und mit gleichen abstand. dann im blatt von 0004.png bis 0006.png usw...
Ist das auch möglich?
Code:
Sub Makro1TEEST()
'
' Makro1TEEST Makro
'
'
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 399, 81, 54.75, _
13.5).Select
Range("K7").Select
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
Selection.ShapeRange.ScaleWidth 12, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 3, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 24
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 192, 0)
.Transparency = 0
.Solid
End With
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"Hier Steht der Überschrift"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 26). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 10).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 32
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(11, 16).Font
.BaselineOffset = 0
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 32
.Name = "+mn-lt"
End With
Range("F17").Select
ActiveSheet.Pictures.Insert("C:\Temp\bild1.png").Select
Selection.ShapeRange.IncrementLeft -72
Selection.ShapeRange.IncrementTop -84
Range("E5").Select
ActiveSheet.Pictures.Insert("C:\Temp\bild2.png").Select
Selection.ShapeRange.IncrementLeft 504.75
Selection.ShapeRange.IncrementTop 97.5
Selection.ShapeRange.IncrementLeft 125.25
Selection.ShapeRange.IncrementTop 12.75
Range("D20").Select
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Selection.ShapeRange.IncrementLeft -104.25
Selection.ShapeRange.IncrementTop -5.25
ActiveSheet.Shapes.Range(Array("Picture 5")).Select
Selection.ShapeRange.IncrementLeft -233.25
Selection.ShapeRange.IncrementTop -18.75
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Selection.ShapeRange.IncrementLeft 25.5
Selection.ShapeRange.IncrementTop 36
ActiveSheet.Shapes.Range(Array("Picture 5")).Select
Selection.ShapeRange.IncrementLeft 30
Selection.ShapeRange.IncrementTop 41.25
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
Selection.ShapeRange.IncrementLeft 140.25
Selection.ShapeRange.IncrementTop 7.5
Columns("M:M").Select
ActiveSheet.Pictures.Insert("C:\Temp\bild3.png").Select
Selection.ShapeRange.IncrementLeft 468
Hallo, ich konnte jetzt zumindest 3 Bilder und eine Überschrft hinzufügen. Wie kann ich da jetzt eine schleife einbauen?
Hallöchen,
hier mal wieder etwas theorie. Eine Schleife für 3 Bilder je Blatt könnte man so aufbauen:
Code:
For iCnt = 1 To 100 'Neues Blatt am Ende einfuegen
Sheets.Add After:=ActiveSheet
'Bild entsprechend Liste oben links einfuegen
Cells(2, 2).Select
ActiveSheet.Pictures.Insert(Format(iCnt, "0000") & ".png").Select
Cells(12, 2).Select
ActiveSheet.Pictures.Insert(Format(iCnt + 1, "0000") & ".png").Select
Cells(22, 2).Select
ActiveSheet.Pictures.Insert(Format(iCnt + 2, "0000") & ".png").Select
'Schleifenzaehler hochsetzen
iCnt = iCnt + 2
'Ende Schleife ueber alle Bildeintraege bis zur ersten leeren Zelle
Next
Auf dem neuen Blatt werden nacheinander die 3 Bilder in die Zellen B2, B12 und B22 eingefügt. Dazu wird die entsprechende Zelle ausgewählt und der Bildname über den Format-Befehl gebildet. Vor dem Vormat müsste noch
"LW:\Pfad\" &
kommen. Am Ende der Schleife wird der Zähler noch um 2 hochgesetzt, damit es beim nächsten Durchlauf mit Bild 0004 weitergeht.
Danke für deine Hilfe. Aber ich bekomme eine fehlermeldung bei ActiveSheet.Pictures.Insert("D:\LOOP\" & (Format(iCnt, "0000") & ".png")).Select
Code:
Sub MakroEXCEL()
For iCnt = 1 To 100 'Neues Blatt am Ende einfuegen
Sheets.Add After:=ActiveSheet
'Bild entsprechend Liste oben links einfuegen
Cells(2, 2).Select
ActiveSheet.Pictures.Insert("D:\LOOP\" & (Format(iCnt, "0000") & ".png")).Select
Cells(12, 2).Select
ActiveSheet.Pictures.Insert("D:\LOOP\" & (Format(iCnt + 1, "0000") & ".png")).Select
Cells(22, 2).Select
ActiveSheet.Pictures.Insert("D:\LOOP\" & (Format(iCnt + 2, "0000") & ".png")).Select
'Schleifenzaehler hochsetzen
iCnt = iCnt + 2
'Ende Schleife ueber alle Bildeintraege bis zur ersten leeren Zelle
Next
End Sub
Hab das problem gefunden