Herbers Excel-Forum - das Archiv

verzogene Grafik mit VBA zurücksetzen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: verzogene Grafik mit VBA zurücksetzen
von: Jürg

Geschrieben am: 16.02.2008 21:20:42

Hallo
ich möchte "verzogene" Grafiken mittels VBA anlaog dem Befehl Grafik Formatieren - Grösse - (Seitenverhältnis.. und rel zu Originalgrösse ... Disabled) unter Originalgrösse Zurücksetzen.
Das Makro zeichnet mir die Befehle auf. Ich finde aber in den Objektdaten nicht die Originalgrössen. Wer weiss wie?
Besten Dank

Bild

Betrifft: AW: verzogene Grafik mit VBA zurücksetzen
von: Jens
Geschrieben am: 16.02.2008 22:31:09
Hi,
Grafik ist ein Sammelbegriff, um welche Art Grafik gehts?
Zurücksetzen auf Originalgröße ist nur bei aus Datei eingefügten Grafiken möglich.
mfg Jens

Bild

Betrifft: AW: verzogene Grafik mit VBA zurücksetzen
von: fcs

Geschrieben am: 16.02.2008 22:42:16
Hallo Jürg,
die Originalabmessungen kannst du nach dem zurücksetzen der Grafik ermitteln, indem du die Eigenschaften Height und Width des Shape ausliest.
Gruß
Franz
Beispiel:

Sub Makro1()
Dim Element As Shape, Originalbreite As Double, Originalhoehe As Double
Set Element = ActiveSheet.Shapes("Picture 1")
With Element
' Shape auf Originalgröße setzen
.LockAspectRatio = msoFalse
.ScaleHeight 1, True
.ScaleWidth 1, True
Originalhoehe = .Height 'in Punkten
Originalbreite = .Width 'in Punkten
MsgBox "Original-Höhe: " & Format(Originalhoehe * 2.54 / 72, "0.00") & " cm" & vbLf & _
"Original-Breite: " & Format(Originalbreite * 2.54 / 72, "0.00") & " cm"
'Abmessungen des Shape neu setzen, Breite wird proportional angepasst
.Height = 2 / 2.54 * 72 '2 cm umgerechnet in Punkte
.ScaleWidth .Height / Originalhoehe, True
.LockAspectRatio = msoTrue
End With
End Sub


Bild

Betrifft: AW: verzogene Grafik mit VBA zurücksetzen
von: Jürg

Geschrieben am: 17.02.2008 12:15:06
Hallo Franz
besten Dank für Deine Antwort. Damit konnte ich es lösen. Siehe Beispielcode. Alle Grafiken (aus Datei einfügen) in einer Spalte zurücksetzen.
Danke und Gruss
Jürg

Private Sub CommandButton1_Click()
Dim Spalte, Zelle As String
Dim shp As Shape
Dim Orignalhoehe, Originalbreite As Double
' alle Bilder wieder gleich
Spalte = InputBox("Spalte als Grossbuchstabe eingeben")
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
Zelle = shp.TopLeftCell.Address
If InStr(1, Zelle, Spalte) Then
' Shape auf Originalgröße setzen
shp.LockAspectRatio = msoFalse
shp.ScaleHeight 1, True
shp.ScaleWidth 1, True
Originalhoehe = shp.Height 'in Punkten
Originalbreite = shp.Width 'in Punkten
'  MsgBox "Original-Höhe: " & Format(Originalhoehe * 2.54 / 72, "0.00") & " cm" & vbLf &  _
_
'  "Original-Breite: " & Format(Originalbreite * 2.54 / 72, "0.00") & " cm"
'Abmessungen des Shape neu setzen, Breite wird proportional angepasst
shp.Height = 4 / 2.54 * 72 '4 cm umgerechnet in Punkte
shp.ScaleWidth shp.Height / Originalhoehe, True
shp.LockAspectRatio = msoTrue
End If
End If
Next shp
End Sub


 Bild
Excel-Beispiele zum Thema "verzogene Grafik mit VBA zurücksetzen"
Grafik in Kopfzeile Export von Diagrammen im Grafikformat
Grafiken im Tabellenblatt ordnen Grafiken an eine Seite anpassen
Grafik einfügen, wenn Wert in A1 unter eine Grenze sinkt Grafikprogramm aufrufen und Bild laden
Grafik in Abhängigkeit einer Zelleingabe einfügen Grafik nach Doppelklick laden
Grafiken aus ausgeblendeten Blättern einblenden Grafik nach Eingabe des Dateinamens einfügen