Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
800to804
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Alle Grafiken gleich groß

Alle Grafiken gleich groß
18.09.2006 17:37:39
Tom
Hallo,
wie schaffe ich es, alle Grafiken, die in Tabelle1 liegen, auf einmal auf die Größe 0,5cm x 0,5cm anzupassen bzw nur die Höhe auf 0,5 cm anzupassen?
Danke vorab
TOM

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

Betreff
Datum
Anwender
Anzeige
AW: Alle Grafiken gleich groß
18.09.2006 18:05:04
Josef
Hallo Tom!
Versuch mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub SizeImages(ByVal strSheet As String, ByVal dblHeight As Double, _
  Optional ByVal dblWidth As Double = -1, Optional ByVal LockAR As Boolean = True)

Dim objIMG As Object

dblHeight = Application.CentimetersToPoints(dblHeight)
dblWidth = Application.CentimetersToPoints(dblWidth)

If Not LockAR Then
  If dblWidth = -1 Then dblWidth = dblHeight
End If

For Each objIMG In Sheets(strSheet).Pictures
  With objIMG
    If LockAR Then
      .ShapeRange.LockAspectRatio = True
      .Height = dblHeight
    Else
      .ShapeRange.LockAspectRatio = False
      .Height = dblHeight
      .Width = dblWidth
    End If
  End With
Next

End Sub



Sub test1()
'Breite und Höhe gleich
SizeImages "Tabelle1", 0.5
End Sub


Sub test2()
'Breite und Höhe verschieden
SizeImages "Tabelle1", 2.5, 3.5, False
End Sub


Gruß Sepp

Anzeige
AW: Alle Grafiken gleich groß
18.09.2006 18:08:21
IngGi
Hallo Tom,
folgendes Makro passt Höhe und Breite an. Die Werte sind Punktangaben. Für 0,5 cm musst du eben ein bisschen rumprobieren.

Sub GleicheGroesse()
Dim sh As Shape
For Each sh In Worksheets("Tabelle1").Shapes
sh.Height = 50
sh.Width = 50
Next 'sh
End Sub
Gruß Ingolf
AW: Alle Grafiken gleich groß
19.09.2006 08:19:53
Tom
Danke, funktioniert einwandfrei
TOM

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige