Sub BildgroesseAnpassen()
'Aktivierte Grafik formatieren :
If TypeName(Selection) = "Picture" Then 'nur wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = False
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9.03)
End With
End If
End Sub
Sub AlleBildgroessenAnpassen()
Dim objPic As Object
For Each objPic In ActiveSheet.Pictures
'Alle Grafiken formatieren :
With objPic.ShapeRange
.LockAspectRatio = False
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9.03)
End With
Next
End Sub
Sub AlleBildgroessenAnpassen()
Dim objPic As Object
For Each objPic In ActiveDocument.InlineShapes
With objPic
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(9.03)
.Height = Application.CentimetersToPoints(6.77)
End With
Next
End Sub
ein Querformatbild muss die Maße ja "anders herum" haben.
Geht es nicht irgendwie, dass das Bild bereits beim einfügen angepasst wird?
'Erstellt unter Word 2003 / Windows XP
Sub Grafik_Laden()
' Grafik_Laden Makro
' Grafik laden, Größe anpassen und ggf. drehen
Dim objDoc As Document, DateiGrafik As Variant, objGrafik As InlineShape
Dim objShape As Shape
Dim Auswahl
Set objDoc = ActiveDocument
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte zu ladende Grafikdatei auswählen"
.InitialView = msoFileDialogViewPreview
.ButtonName = "Datei wählen"
If .Show = -1 Then
Selection.InlineShapes.AddPicture FileName:= _
.SelectedItems(1), LinkToFile:=False, SaveWithDocument:=True
Set objGrafik = objDoc.InlineShapes(objDoc.InlineShapes.Count)
'Eingefügtes Bild formatieren - Zeilen mit nicht anzupassenden Formate ggf. _
auskommentieren
With objGrafik
.Fill.Visible = msoFalse
.Fill.Solid
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.Transparency = 0#
.Line.Visible = msoFalse
.LockAspectRatio = msoFalse 'Größenverhältniss nicht sperren - verzerrt ggf die _
Bilder
.Height = Application.CentimetersToPoints(6.77) 'Höhe
.Width = Application.CentimetersToPoints(9.03) 'Breite
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.PictureFormat.ColorType = msoPictureAutomatic
.PictureFormat.CropLeft = 0#
.PictureFormat.CropRight = 0#
.PictureFormat.CropTop = 0#
Set objShape = .ConvertToShape 'Umwandlung für Drehen erforderlich
End With
With objShape
Grafik_Drehen:
.WrapFormat.Type = wdWrapSquare 'für Drehen erforderlich
Auswahl = VBA.InputBox(Prompt:="Bild drehen?" & vbLf & vbLf _
& " 0 = nicht drehen" & vbLf _
& " 1 = 90 Grad nach rechts drehen" & vbLf _
& " 2 = 90 Grad nach links drehen" & vbLf _
& " 3 = 180 Grad nach rechts drehen", _
Title:="Eingefügte Grafik Drehen", _
Default:=0)
If Not Auswahl = False Then
Select Case Auswahl
Case 0
Case 1
.IncrementRotation 90#
Case 2
.IncrementRotation -90#
Case 3
.IncrementRotation -90#
.IncrementRotation -90#
Case Else
MsgBox "Unzulässige Auswahl für Drehen Grafik. Bitte Eingabe wiederholen"
GoTo Grafik_Drehen
End Select
End If
.ConvertToInlineShape 'Rückkonvertierung
End With
End If
End With
End Sub
Sub BildgroesseQuerAnpassen()
'Aktivierte Grafik im Querformat in Größe anpassen
Dim objRange As Object
On Error GoTo Fehler
Set objRange = Selection.InlineShapes(1)
With objRange
.LockAspectRatio = False
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9.03)
End With
Fehler:
With Err
Select Case .Number
Case 0 'Kein Fehler
Case Else
MsgBox "Fehler-nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Sub BildgroesseHochAnpassen()
'Aktivierte Grafik im Hochformat in Größe reduzieren
Dim objRange As Object
On Error GoTo Fehler
Set objRange = Selection.InlineShapes(1)
With objRange
.LockAspectRatio = False
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Height = Application.CentimetersToPoints(9.03)
.Width = Application.CentimetersToPoints(6.77)
End With
Fehler:
With Err
Select Case .Number
Case 0 'Kein Fehler
Case Else
MsgBox "Fehler-nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Um die Bildgröße automatisch anzupassen, kannst Du ein VBA-Makro verwenden. Hier ist eine einfache Anleitung, um die Größe von Bildern in Excel oder Word zu ändern:
Öffne Excel oder Word und drücke ALT + F11, um den VBA-Editor zu öffnen.
Füge ein neues Modul hinzu: Rechtsklicke im Projektfenster auf "VBAProject" und wähle "Einfügen" > "Modul".
Kopiere den folgenden Code in das Modul:
Für Excel:
Sub AlleBildgroessenAnpassen()
Dim objPic As Object
For Each objPic In ActiveSheet.Pictures
With objPic.ShapeRange
.LockAspectRatio = False
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9.03)
End With
Next
End SubFür Word:
Sub AlleBildgroessenAnpassen()
Dim objPic As Object
For Each objPic In ActiveDocument.InlineShapes
With objPic
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(9.03)
.Height = Application.CentimetersToPoints(6.77)
End With
Next
End SubSchließe den VBA-Editor und gehe zurück zu Excel oder Word.
Führe das Makro aus: Drücke ALT + F8, wähle das Makro aus und klicke auf "Ausführen".
Fehler: Laufzeitfehler 424: Objekt erforderlich: Dieser Fehler tritt auf, wenn kein Bild ausgewählt ist. Stelle sicher, dass Du ein Bild markierst, bevor Du das Makro ausführst.
Problem: Bilder werden in der falschen Ausrichtung angepasst: Achte darauf, die Höhe und Breite je nach Ausrichtung des Bildes anzupassen. Du kannst separate Makros für Hoch- und Querformatbilder erstellen.
Makro funktioniert nicht beim Einfügen von Bildern: Es gibt kein Ereignis in Excel, das das automatische Anpassen beim Einfügen von Bildern ermöglicht. Du musst das Makro manuell nach dem Einfügen der Bilder ausführen.
Eine andere Möglichkeit, die Bildgröße automatisch anzupassen, besteht darin, die Bilder zunächst in Excel zu platzieren und dann mit einem Makro für Word zu arbeiten, das alle Bilder in einem Dokument anpasst. Verwende dazu den Dialog zum Auswählen von Dateien, um Bilder direkt ins Word-Dokument einzufügen.
Excel-Bild in Zelle einfügen: Um Bilder in Excel in eine Zelle einzufügen und die Größe automatisch anzupassen, kannst Du das folgende Makro verwenden:
Sub BildInZelleEinfügen()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim pic As Picture
Set pic = ws.Pictures.Insert("Pfad\zu\deinem\Bild.jpg")
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Width = ws.Range("A1").Width
.Height = ws.Range("A1").Height
.Top = ws.Range("A1").Top
.Left = ws.Range("A1").Left
End With
End SubWord-Bildgröße anpassen: Wenn Du Bilder in ein Word-Dokument mit festen Maßen einfügst, kannst Du die Größe mit dem folgenden Makro anpassen:
Sub GrafikLaden()
Dim objDoc As Document
Set objDoc = ActiveDocument
Dim objGrafik As InlineShape
Set objGrafik = objDoc.InlineShapes.AddPicture("Pfad\zu\deinem\Bild.jpg", LinkToFile:=False, SaveWithDocument:=True)
With objGrafik
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(9.03)
.Height = Application.CentimetersToPoints(6.77)
End With
End SubMakros in der Normal.dot speichern: Um die Makros jederzeit verfügbar zu haben, speichere sie in der Normal.dot-Vorlage von Word.
Verwende Shortcuts: Weisen Sie häufig verwendeten Makros Shortcuts zu, um sie schneller aufzurufen.
InputBox zur Anpassung: Mit einer InputBox kannst Du auch dynamisch entscheiden, welche Maße für die Bildgröße verwendet werden sollen.
1. Wie kann ich die Größe von Bildern in Excel automatisch anpassen?
Verwende ein VBA-Makro, das die Größe der Bilder auf die gewünschten Maße einstellt, nachdem sie in das Arbeitsblatt eingefügt wurden.
2. Gibt es eine Möglichkeit, Bilder beim Einfügen in Word anzupassen?
Ja, Du kannst ein Makro erstellen, das die Größe von Bildern anpasst, während Du sie in das Dokument einfügst.
3. Was tun, wenn Bilder bei der Anpassung verzerrt werden?
Stelle sicher, dass die LockAspectRatio-Eigenschaft auf False gesetzt ist, um die Breite und Höhe unabhängig zu steuern.
4. Kann ich alle Bilder in einem Word-Dokument gleichzeitig anpassen?
Ja, indem Du ein Makro verwendest, das durch alle InlineShapes im Dokument iteriert und die Größe anpasst.
5. Gibt es eine Möglichkeit, Bilder in einer Tabelle in Word anzupassen?
Du kannst ein Makro erstellen, das gezielt nur die Bilder in bestimmten Zellen einer Tabelle anpasst.