Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
952to956
952to956
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

verzogene Grafik mit VBA zurücksetzen

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

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

Betreff
Datum
Anwender
Anzeige
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


Anzeige
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


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige