Grafikdetails

Hallo zusammen!
Ich möchte von einer Grafik in Excel die Eigenschaften (Höhe, Breite...)
einlesen. Dazu hab ich mir ein Makro zusammengebaut. Viele von Euch
werden lachen, wenn Sie mein Makro sehen.... aber aller Anfang ist schwer.
Leider funktioniert mein Makro nicht wie ich es will. Ziel wäre, dass bei
markierter Grafik das Makro gestartet wird und die Details in entsprechende
Variablen eingelesen werden.
Wieso funkts nicht? Kann mir jemand helfen?
Schöne Grüße
Andreas
Option Explicit
Dim Links, Oben, Rechts, Unten, Höhe, Breite


Sub Einlesen()
Application.SendKeys "%t", True
Application.SendKeys "G", True
Application.SendKeys "{TAB}", True
Application.SendKeys "^c", True
Set Links = New DataObject
Links.GetFromClipboard
Links = Links.GetText(1)
Application.SendKeys "{TAB}", True
Application.SendKeys "^c", True
Set Oben = New DataObject
Oben.GetFromClipboard
Oben = Oben.GetText(1)
Application.SendKeys "{TAB}", True
Application.SendKeys "^c", True
Set Rechts = New DataObject
Rechts.GetFromClipboard
Rechts = Rechts.GetText(1)
Application.SendKeys "{TAB}", True
Application.SendKeys "^c", True
Set Unten = New DataObject
Unten.GetFromClipboard
Unten = Unten.GetText(1)
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{LEFT}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "^c", True
Set Höhe = New DataObject
Höhe.GetFromClipboard
Höhe = Höhe.GetText(1)
Application.SendKeys "{TAB}", True
Application.SendKeys "^c", True
Set Breite = New DataObject
Breite.GetFromClipboard
Breite = Breite.GetText(1)
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{RETURN}", True
BlockInput False
End Sub


Sub Auslesen()
Cells(1, 1) = Links
Cells(1, 2) = Oben
Cells(1, 3) = Rechts
Cells(1, 4) = Unten
Cells(1, 5) = Höhe
Cells(1, 6) = Breite
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Grafikdetails

10.04.2006 14:42:13

ANdreas

AW: Grafikdetails

10.04.2006 15:12:25

AndreasB

AW: Grafikdetails

10.04.2006 15:45:07

Andreas

Wunderbar!!!

10.04.2006 16:00:26

AndreasB

Sub getSize() Dim s$ 'wenn Grafik selektiert Select Case TypeName(Selection) Case "Picture": With Selection s = "Position links: " & .Left & vbCrLf s = s & "Position oben: " & .Top & vbCrLf s = s & "Breite: " & .Width & vbCrLf s = s & "Höhe: " & .Height End With MsgBox s, , Selection.Name Case Else MsgBox "Keine Grafik!", , TypeName(Selection) End Select End Sub

Sub getSize() Dim s$, sh As Shape 'wenn Grafik selektiert Select Case TypeName(Selection) Case "Picture": Set sh = ActiveSheet.Shapes(Selection.Name) With sh s = "Links: " & .PictureFormat.CropLeft & vbCrLf s = s & "Position oben: " & .Top & vbCrLf s = s & "Breite: " & .Width & vbCrLf s = s & "Höhe: " & .Height End With MsgBox s, , sh.Name Case Else MsgBox "Keine Grafik!", , TypeName(Selection) End Select End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread