Finde den Typ einer Form
Möchte ich zeigen alle shape-Typen, die ich in eine powerpoint-Präsentation. Ich habe versucht mit diesen codes:
Private Sub CommandButton1_Click()
Dim it As String
Dim i As Integer
Dim Ctr As Integer
'''''''''''''''''
'Read-only Long
'''''''''''''''''
For Each slid In ActivePresentation.Slides
For Each s In slid.Shapes
'No need to select the object in order to use it
With s
'But it is easier to watch when the object is selected
'This next line is for demonstration purposes only.
'It is not necessary
s.Select
Select Case .Type
'Type 1
Case msoAutoShape
it = "an AutoShape. Type : " & .Type
'Type 2
Case msoCallout
it = "a Callout. Type : " & .Type
'Type 3
Case msoChart
it = "a Chart. Type : " & .Type
'Type 4
Case msoComment
it = "a Comment. Type : " & .Type
'Type 5
Case msoFreeform
it = "a Freeform. Type : " & .Type
'Type 6
Case msoGroup
it = "a Group. Type : " & .Type
' If it's a group them iterate thru
' the items and list them
it = it & vbCrLf & "Comprised of..."
For Ctr = 1 To .GroupItems.Count
it = it & vbCrLf & _
.GroupItems(Ctr).Name & _
". Type:" & .GroupItems(Ctr).Type
Next Ctr
'Type 7
Case msoEmbeddedOLEObject
it = "an Embedded OLE Object. Type : " & .Type
'Type 8
Case msoFormControl
it = "a Form Control. Type : " & .Type
'Type 9
Case msoLine
it = "a Line. Type : " & .Type
'Type 10
Case msoLinkedOLEObject
it = "a Linked OLE Object. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & "My Source: " & _
.SourceFullName
End With
'Type 11
Case msoLinkedPicture
it = "a Linked Picture. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & "My Source: " & _
.SourceFullName
End With
'Type 12
Case msoOLEControlObject
it = "an OLE Control Object. Type : " & .Type
'Type 13
Case msoPicture
it = "a embedded picture. Type : " & .Type
'Type 14
Case msoPlaceholder
it = "a text placeholder (title or regular text--" & _
"not a standard textbox) object." & _
"Type : " & .Type
'Type 15
Case msoTextEffect
it = "a WordArt (Text Effect). Type : " & .Type
'Type 16
Case msoMedia
it = "a Media object .. sound, etc. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & " My Source: " & _
.SourceFullName
End With
'Type 17
Case msoTextBox
it = "a Text Box."
'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
'Case msoScriptAnchor
Case 18
it = " a ScriptAnchor. Type : " & .Type
'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
'Case msoTable
Case 19
it = " a Table. Type : " & .Type
'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
'Case msoCanvas
Case 20
it = " a Canvas. Type : " & .Type
'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
'Case msoDiagram
Case 22
it = " a Diagram. Type : " & .Type
'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
'Case msoInk
Case 22
it = " an Ink shape. Type : " & .Type
'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
'Case msoInkComment
Case 23
it = " an InkComment. Type : " & .Type
'Type -2
Case msoShapeTypeMixed
it = "a Mixed object (whatever that might be)." & _
"Type : " & .Type
'Just in case
Case Else
it = "a mystery!? An undocumented object type?" & _
" Haven't found one of these yet!"
End Select
MsgBox ("I'm " & it)
End With
Next
Next
End Sub
Ich habe diesen code aus diesem einen und ändern ein wenig, aber niemand arbeitet für mich:
Sub Object_Types_on_This_Slide()
'Refers to each object on the current page and returns the Shapes.Type
'Can be very useful when searching through all objects on a page
Dim it As String
Dim i As Integer
Dim Ctr As Integer
'''''''''''''''''
'Read-only Long
'''''''''''''''''
For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
'No need to select the object in order to use it
With ActiveWindow.Selection.SlideRange.Shapes(i)
'But it is easier to watch when the object is selected
'This next line is for demonstration purposes only.
'It is not necessary
ActiveWindow.Selection.SlideRange.Shapes(i).Select
Select Case .Type
'Type 1
Case msoAutoShape
it = "an AutoShape. Type : " & .Type
'Type 2
Case msoCallout
it = "a Callout. Type : " & .Type
'Type 3
Case msoChart
it = "a Chart. Type : " & .Type
'Type 4
Case msoComment
it = "a Comment. Type : " & .Type
'Type 5
Case msoFreeform
it = "a Freeform. Type : " & .Type
'Type 6
Case msoGroup
it = "a Group. Type : " & .Type
' If it's a group them iterate thru
' the items and list them
it = it & vbCrLf & "Comprised of..."
For Ctr = 1 To .GroupItems.Count
it = it & vbCrLf & _
.GroupItems(Ctr).Name & _
". Type:" & .GroupItems(Ctr).Type
Next Ctr
'Type 7
Case msoEmbeddedOLEObject
it = "an Embedded OLE Object. Type : " & .Type
'Type 8
Case msoFormControl
it = "a Form Control. Type : " & .Type
'Type 9
Case msoLine
it = "a Line. Type : " & .Type
'Type 10
Case msoLinkedOLEObject
it = "a Linked OLE Object. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & "My Source: " & _
.SourceFullName
End With
'Type 11
Case msoLinkedPicture
it = "a Linked Picture. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & "My Source: " & _
.SourceFullName
End With
'Type 12
Case msoOLEControlObject
it = "an OLE Control Object. Type : " & .Type
'Type 13
Case msoPicture
it = "a embedded picture. Type : " & .Type
'Type 14
Case msoPlaceholder
it = "a text placeholder (title or regular text--" & _
"not a standard textbox) object." & _
"Type : " & .Type
'Type 15
Case msoTextEffect
it = "a WordArt (Text Effect). Type : " & .Type
'Type 16
Case msoMedia
it = "a Media object .. sound, etc. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & " My Source: " & _
.SourceFullName
End With
'Type 17
Case msoTextBox
it = "a Text Box."
'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
'Case msoScriptAnchor
Case 18
it = " a ScriptAnchor. Type : " & .Type
'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
'Case msoTable
Case 19
it = " a Table. Type : " & .Type
'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
'Case msoCanvas
Case 20
it = " a Canvas. Type : " & .Type
'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
'Case msoDiagram
Case 22
it = " a Diagram. Type : " & .Type
'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
'Case msoInk
Case 22
it = " an Ink shape. Type : " & .Type
'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
'Case msoInkComment
Case 23
it = " an InkComment. Type : " & .Type
'Type -2
Case msoShapeTypeMixed
it = "a Mixed object (whatever that might be)." & _
"Type : " & .Type
'Just in case
Case Else
it = "a mystery!? An undocumented object type?" & _
" Haven't found one of these yet!"
End Select
MsgBox ("I'm " & it)
End With
Next i
End Sub
Warum es nicht funktioniert? Mache ich etwas falsch?
- haben Sie irgendwelche Fehler oder einfach keine Ergebnisse?? Die zweite funktioniert für mich ganz ok 🙂
- Ja, es gab mir eine Fehlermeldung... In activewindow. Jetzt i dont haben den pc bei mir, so kann ich nicht überprüfen. Morgen werde ich. Btw-vielen Dank! Sie sind in allen vba-threads, die ich Schreibe 🙂
- Es gibt nur wenige activewindows Linie ist, aber ich glaube, Sie haben einen Fehler in der ersten, die Fehler konnte ich reproduzieren, jetzt, auch. Wollen Sie führen Sie Ihre subroutine nur für eine Folie, aktive Folie oder Folien ausgewählt? Können wir zurück zu jenem morgen...
- Ja, ich habe die Fehler in der ersten. Ich möchte es für alle Folien meiner Präsentation, da habe ich um zu überprüfen, alle die verschiedenen Arten, sind in der Präsentation, um verschiedene Dinge, die es mit jedem.
Du musst angemeldet sein, um einen Kommentar abzugeben.
Fand ich einen Weg zu machen, während die Diashow läuft. Hier ist der code:
Hoffe, dass Sie hilfreich sein für jemanden.
Wenn Sie möchten, Unterprogramm zu arbeiten für die einzelnen Dias der Präsentation, als Sie brauchen, um wieder externe Schleife, die Sie entfernt.
gibt es 3 Zeilen, die Sie entfernen müssen, und einige, die Sie brauchen, um stattdessen:
Hoffe, ich habe nichts verpasst 🙂