verzogene Grafik mit VBA zurücksetzen

Forumthread: verzogene Grafik mit VBA zurücksetzen

16.02.2008 21:20:00

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: verzogene Grafik mit VBA zurücksetzen

16.02.2008 22:31:09

Jens

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

AW: verzogene Grafik mit VBA zurücksetzen

16.02.2008 22:42:16

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

AW: verzogene Grafik mit VBA zurücksetzen

17.02.2008 12:15:06

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

Beliebteste Forumthreads (12 Monate)

verzogene Grafik mit VBA zurücksetzen

Forumthread: verzogene Grafik mit VBA zurücksetzen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread