Herbers Excel-Forum - das Archiv
verzogene Grafik mit VBA zurücksetzen
- verzogene Grafik mit VBA zurücksetzen von Jürg vom 16.02.2008 21:20:42
- AW: verzogene Grafik mit VBA zurücksetzen - von Jens am 16.02.2008 22:31:09
- AW: verzogene Grafik mit VBA zurücksetzen - von fcs am 16.02.2008 22:42:16
- AW: verzogene Grafik mit VBA zurücksetzen - von Jürg am 17.02.2008 12:15:06
- AW: verzogene Grafik mit VBA zurücksetzen - von Jürg am 17.02.2008 12:15:06
 |
Betrifft: verzogene Grafik mit VBA zurücksetzen
von: Jürg
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
 |
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
|
Betrifft: AW: verzogene Grafik mit VBA zurücksetzen
von: fcs
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
|
Betrifft: AW: verzogene Grafik mit VBA zurücksetzen
von: Jürg
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
| |