VBA Bilder einfügen - Bildgröße

Forumthread: VBA Bilder einfügen - Bildgröße

11.04.2017 12:42:11

Achim

Hallo Zusammen,
irgendwie sehe ich den Wald vor lauter Bäumen nicht mehr.
Ich habe ein paar Makros geschrieben, die in eine Tabelle Bilder einfügen sollen.
Da die Bilder immer unterschiedliche Größe haben und ich mit einem Layout bei
den Excelblättern arbeite, gehe ich einen Umweg und füge die Bilder auf einem
temporären Tabellenblatt ein. (Vielleicht geht dies auch direkt, aber ich hatte bei ausgeblendeten Spalten immer Schwierigkeiten.)
Dies funktioniert mit der Funktion "Sheets("Bilder_Temp").Pictures.Insert" auch sehr gut. Leider fügt diese Funktion nur Links ab Excel 2010 ein. Jetzt möchte ich meine Makros umbauen und die Funktion "Sheets("Bilder_Temp").Shapes.AddPicture" verwenden.
Irgendwie finde ich gerade die Funktion zum ändern z.B. der Bildbreite nicht.
Kann mir jemand einen Tipp geben.
Noch eine Kleinigkeit tritt bei diesen Makros auf. Ich möchte nach dem Einfügen ein PDF erstellen - kein Problem grundsätzlich - aber wenn ich mit der PasteSpecial-Methode die Bilder aktuell kopiere, funktioniert im PDF das direkte Copy&Paste nicht mehr. Die normale Paste-Funktion arbeitet wieder nur mit Links. Irgendwie wird das Bild im PDF nicht als Bild eingebettet und dies führt dazu, dass die Bilder nicht direkt kopiert werden können und beim Pasten ein schwarzes Bild entsteht. Die Screenshot-PDF-Funktion ist auf Grund der Bilderanzahl nicht zielführend.
Hier seht ihr das erste Makro und in welche Richtung ich gehen möchte.
Weiter unten seht ihr das zweite Makro, welches noch vollständig mit ".insert" arbeitet.
Übersehe ich etwas, oder was mach ich falsch.

Sub Uebersichts_Bilder_einfuegen()
Dim bytBild As Byte
Dim arrBereiche1()
Dim arrBereiche2()
Dim Bildname As String
Dim Teile As Variant
Dim ic As Integer
'arrBereiche
arrBereiche1 = Array("C3", "C53", "C103", "C153", "C203")
arrBereiche2 = Array("C2", "C52", "C102", "C152", "C202")
'Auswahl des Tabellenblattes, damit das Makro sauber laeuft
ThisWorkbook.Sheets("Uebersichtsbilder").Select
'Screenupdate deaktivieren
Application.ScreenUpdating = False
'Aufruf Fileopendialog und Bilder auswaehlen
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = ActiveWorkbook.Path
.ButtonName = "OK"
.Title = "Bilderauswahl"
.Show
'Bilder einfügen - maximal moegliche Bildanzahl 30
If .SelectedItems.Count

Sub Bilder_einfuegen2()
Dim bytBild As Byte
Dim arrBereiche1()
Dim arrBereiche2()
Dim Bildname As String
Dim Teile As Variant
Dim ic As Integer
'arrBereiche
arrBereiche1 = Array("C3", "C28", "C53", "C78", "C103", "C128", "C153", "C178", "C203", " _
C228", "C253", "C278", _
"C303", "C328", "C353", "C378", "C403", "C428", "C453", "C478", "C503", "C528", "C553", " _
C578", _
"C603", "C628", "C653", "C678", "C703", "C728", "C753", "C778", "C803", "C828", "C853", " _
C878")
arrBereiche2 = Array("C2", "C27", "C52", "C77", "C102", "C127", "C152", "C177", "C202", " _
C227", "C252", "C277", _
"C302", "C327", "C352", "C377", "C402", "C427", "C452", "C477", "C502", "C527", "C552", " _
C577", _
"C602", "C627", "C652", "C677", "C702", "C727", "C752", "C777", "C802", "C827", "C852", " _
C877")
'Auswahl des Tabellenblattes, damit das Makro sauber laeuft
ThisWorkbook.Sheets("Bilder").Select
'Screenupdate deaktivieren
Application.ScreenUpdating = False
'Aufruf Fileopendialog und Bilder auswaehlen
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = ActiveWorkbook.Path
'.InitialFileName = "D:\TEMP\Bilder"
.ButtonName = "OK"
.Title = "Bilderauswahl"
.Show
'Bilder einfügen - maximal moegliche Bildanzahl 30
If .SelectedItems.Count  300 Then
With .ShapeRange
.LockAspectRatio = msoTrue
.Height = 310
End With
End If
Sheets("Bilder_Temp").Pictures("Bild_Temp").Cut
'vorhandene Bilder zaehlen
ic = Sheets("Bilder").Shapes.Count
'Bilder auf den naechsten verfuegbaren Platz setzen
With Sheets("Bilder")
.Select
.Range(arrBereiche1(ic)).Select
'.Paste
.PasteSpecial Format:="Picture (JPEG)", Link:=False, DisplayAsIcon:= _
False
End With
Range(arrBereiche2(ic)) = Bildname
'.Range(arrBereiche1(bytBild - 1)).Select
End With
Next bytBild
Else
MsgBox "Maximal 30 Bilder auswählbar"
End If
End With
Application.ScreenUpdating = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Bilder einfügen - Bildgröße

11.04.2017 15:48:40

JoWE

Hi,
Bild einfügen und Bildbreite ändern funktioniert im Grundsatz so:
With ActiveSheet
.Pictures.Insert("C:\Temp\myDisplay.jpg").Select
.Pictures.ShapeRange.LockAspectRatio = msoTrue
.Pictures.ShapeRange.Width = 141.7322834646 '5cm
'.Pictures.ShapeRange.Height = 141.7322834646
End With
habe die Tabelle als pdf gespeichert, Bild ist sichtbar.
Habe allerdings Excel 15.0
Gruß
Jochen

AW: VBA Bilder einfügen - Bildgröße

11.04.2017 17:23:35

Achim

Hallo Jochen,
dein Skript ist analog zu meinem Makro 2. Das Problem ist vermutlich nicht die Funktion Picture.insert, sondern
die Kombination mit der Funktion PasteSpecial. Auch das Bild ist immer im PDF sichtbar, aber wenn
ich das Bild im PDF markiere und Copy&Paste z.B. nach PowerPoint durchführe, dann führt Picture.Insert + PasteSpecial zu einem schwarzen Bild. Die Kombination Picture.Insert + Paste führt zu einem PDF mit
dem Copy&Paste möglich ist, aber dafür sind die Bilder in Excel nur verlinkt sind. Deshalb der geplante Weg mit der Funktion Shapes.AddPicture.
Ich benötige eine Funktion die folgendes kann:
1. Bild als Shape in Excel einfügen (mein Weg über ein Hilfstabelle wurde gewählt, da
ich bestimmte Reihen ausblende und dies beim Einfügen Probleme erzeugt hat.)
2. Bildgröße anpassen
3. Bild an eine Position verschieben
4. PDF erstellen, in dem die Bilder als Bild erkannt werden - dies scheint nur der Fall zu sein, wenn
das Bild als Shape in Excel vorliegt.

AW: VBA Bilder einfügen - Bildgröße

11.04.2017 19:45:42

JoWE

Hallo,
probier's mal so:

Sub Uebersichts_Bilder_einfuegen()
Dim bytBild As Byte
Dim arrBereiche1()
Dim arrBereiche2()
Dim Bildname As String
Dim Teile As Variant
Dim ic As Integer
'arrBereiche
arrBereiche1 = Array("C3", "C53", "C103", "C153", "C203")
arrBereiche2 = Array("C2", "C52", "C102", "C152", "C202")
'Auswahl des Tabellenblattes, damit das Makro sauber laeuft
ThisWorkbook.Sheets("Uebersichtsbilder").Select
'Screenupdate deaktivieren
Application.ScreenUpdating = False
'Aufruf Fileopendialog und Bilder auswaehlen
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = ActiveWorkbook.Path
.ButtonName = "OK"
.Title = "Bilderauswahl"
.Show
'Bilder einfügen - maximal moegliche Bildanzahl 30
If .SelectedItems.Count

Gruß
Jochen

AW: VBA Bilder einfügen - Bildgröße

11.04.2017 20:03:50

Achim

Super Jochen,
das mit dem Cut hat gefehlt. Manchmal ist es halt nur eine Kleinigkeit.
Hab's jetzt so angepasst und das PasteSpecial weggelassen.
Jetzt funktioniert alles.
Danke!
Achim
'Einfügen der Bauteilübersichtsbilder

Sub Uebersichts_Bilder_einfuegen()
Dim bytBild As Byte
Dim arrBereiche1()
Dim arrBereiche2()
Dim Bildname As String
Dim Teile As Variant
Dim ic As Integer
'arrBereiche
arrBereiche1 = Array("C3", "C53", "C103", "C153", "C203")
arrBereiche2 = Array("C2", "C52", "C102", "C152", "C202")
'Auswahl des Tabellenblattes, damit das Makro sauber laeuft
ThisWorkbook.Sheets("Uebersichtsbilder").Select
'Screenupdate deaktivieren
Application.ScreenUpdating = False
'Aufruf Fileopendialog und Bilder auswaehlen
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = ActiveWorkbook.Path
.ButtonName = "OK"
.Title = "Bilderauswahl"
.Show
'Bilder einfügen - maximal moegliche Bildanzahl 5
If .SelectedItems.Count

Infobox / Tutorial

Bilder in Excel mit VBA einfügen und anpassen

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Makro erstellen: Öffne den VBA-Editor (ALT + F11) und erstelle ein neues Modul.
Bilder auswählen: Nutze Application.FileDialog, um einen Dialog zum Auswählen von Bildern zu öffnen.

Bilder einfügen:

With Application.FileDialog(msoFileDialogFilePicker)
   .AllowMultiSelect = True
   .Show
   For i = 1 To .SelectedItems.Count
       Dim Bild As String
       Bild = .SelectedItems(i)
       'Füge das Bild als Shape ein
       Dim shp As Shape
       Set shp = ThisWorkbook.Sheets("Bilder").Shapes.AddPicture(Bild, _
           msoFalse, msoCTrue, 0, 0, -1, -1)
       'Bildgröße anpassen
       shp.LockAspectRatio = msoTrue
       shp.Width = 141.73 ' Beispielbreite in cm
   Next i
End With

PDF erstellen: Verwende ActiveSheet.ExportAsFixedFormat, um das Arbeitsblatt als PDF zu speichern.

Häufige Fehler und Lösungen

Bild wird nicht angezeigt: Überprüfe, ob die Bildpfade korrekt sind. Stelle sicher, dass du die Bilder als Shapes einfügst, um sie im PDF sichtbar zu machen.
Schwarzes Bild im PDF: Dies tritt häufig auf, wenn du die PasteSpecial-Methode verwendest. Stelle sicher, dass du die Bilder direkt als Shapes einfügst und nicht über die Zwischenablage.
Bildgröße wird nicht angepasst: Verwende die LockAspectRatio-Eigenschaft, um die Proportionen beizubehalten, und passe die Width oder Height an.

Alternative Methoden

Direktes Einfügen ohne temporäres Blatt: Anstatt Bilder auf einem temporären Blatt einzufügen, kannst du sie direkt in das Zielblatt einfügen. Achte darauf, dass die Position und Größe korrekt eingestellt sind.
Verwendung von Shapes.AddPicture: Diese Methode erlaubt es, Bilder als Shapes einzufügen, was für die PDF-Generierung essenziell ist, da sie direkt im PDF eingebettet werden.

Praktische Beispiele

Hier ist ein Beispiel, um mehrere Bilder einfügen und anpassen:

Sub BilderEinfügenUndAnpassen()
    Dim dlg As FileDialog
    Dim shp As Shape
    Dim i As Integer

    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    With dlg
        .AllowMultiSelect = True
        If .Show = -1 Then
            For i = 1 To .SelectedItems.Count
                Set shp = ThisWorkbook.Sheets("Bilder").Shapes.AddPicture(.SelectedItems(i), _
                    msoFalse, msoCTrue, 0, 0, -1, -1)
                shp.LockAspectRatio = msoTrue
                shp.Width = 141.73 ' Beispielbreite
            Next i
        End If
    End With
End Sub

Tipps für Profis

Verwende Konstanten für Bildgrößen: Definiere Konstanten für die Bildbreite und -höhe, um die Wartbarkeit deines Codes zu verbessern.
Fehlerbehandlung einfügen: Implementiere eine Fehlerbehandlung, um unerwartete Probleme bei der Bildauswahl oder dem Einfügen zu vermeiden.
Batch-Prozesse nutzen: Wenn du viele Bilder einfügen musst, erwäge, die Bilder in einem Batch-Prozess zu verarbeiten, um die Performance zu verbessern.

FAQ: Häufige Fragen

1. Wie kann ich die Größe der Bilder in Excel anpassen?
Du kannst die Größe der Bilder anpassen, indem du die Eigenschaften Width und Height des Shapes änderst. Stelle sicher, dass LockAspectRatio aktiviert ist, um die Proportionen beizubehalten.

2. Warum werden meine Bilder im PDF nicht angezeigt?
Das liegt häufig daran, dass die Bilder nicht als Shapes eingefügt wurden. Verwende die Methode Shapes.AddPicture, um sicherzustellen, dass die Bilder im PDF sichtbar sind.

3. Wie viele Bilder kann ich gleichzeitig einfügen?
Es gibt keine feste Grenze, aber es wird empfohlen, die Anzahl der Bilder auf 30 zu begrenzen, um die Performance nicht zu beeinträchtigen.

Beliebteste Forumthreads (12 Monate)

VBA Bilder einfügen - Bildgröße

Forumthread: VBA Bilder einfügen - Bildgröße

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Bilder in Excel mit VBA einfügen und anpassen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread