Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

verzogene Grafik mit VBA zurücksetzen

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

  

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
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




  

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




 

Beiträge aus den Excel-Beispielen zum Thema "verzogene Grafik mit VBA zurücksetzen"