我有一个PowerPoint宏，可以遍历给定路径中的所有PowerPoint文件，并检查任何感兴趣的内容。
我的代码运行。在某一点上，我通过使用shape.mediatype属性检查嵌入的视频或声音。
我发现这个https://learn.microsoft.com/en-us/office/vba/api/powerpoint.ppmediatype知道我可以期望找到这个属性，但我不知道ppMediaTypeMixed或ppMediaTypeOther是什么，微软告诉我"这是混合媒体!"不帮助。
这两个代表什么?
宏的代码(仍然是WIP)。
Sub PowerPoint_Check_v2()
Dim fldpath As String
Dim filepath As String
Dim Longsum As String
Dim Shortsum As String
Dim com As Comment
Dim pres As Presentation
Dim hyp As hyperlink
Dim sld As Slide
Dim dsg As Design
Dim cstmly As CustomLayout
Dim shape As shape
Dim totnote As Long
Dim tothyp As Long
Dim sldcom As Long
Dim totcom As Long
Dim curdsg As Long
Dim dsgcstmly As Long
Dim hypsld As Long
Dim totchart As Long
Dim sldchart As Long
Dim cursld As Long
Dim hidsld As Long
fldpath = UserForm1.TextBox1.Text & ""
filepath = Dir(fldpath & "*.ppt*")
'loop through all ppt/pptx/pptm in that path
Do While filepath <> ""
totchart = 0
tothyp = 0
sldchart = 0
cursld = 1
hidlsd = 0
curdsg = 1
tothyp = 0
On Error Resume Next 'for testing so I do not have to to delete the folders every time since it overwrites the files
MkDir (fldpath & "Detailled reports")
MkDir (fldpath & "Short Summary reports")
Shortsum = fldpath & "Short Summary reportsShortSum_" & filepath & ".txt"
Longsum = fldpath & "Detailled reportsDetailRep_" & filepath & ".txt"
Open Shortsum For Output As #1
Open Longsum For Output As #2
Set pres = Application.Presentations.Open(fldpath & filepath)
With pres
Print #1, "filename: " & .Name
Print #1, "Total number of slides: " & .Slides.Count
Print #2, "filename: " & .Name
Print #2, "Total number of slides: " & .Slides.Count
'count master designs
Print #1, "Number of master designs: " & .Designs.Count
Print #2, "Number of master designs: " & .Designs.Count
'count custom layouts
For Each dsg In .Designs
For Each cstmly In .SlideMaster.CustomLayouts
If cstmly.Shapes.Count <> 0 Then
dsgcstmly = dsgcstmly + 1
End If
Next
Print #2, "Master design " & curdsg & " has " & dsgcstmly & " custom layouts"
curdsg = curdsg + 1
dsgcstmly = 0
Next
'go through all slides and ungroup everything to avoid missing anything
Do While cursld < .Slides.Count
For Each sld In .Slides
For Each shape In sld.Shapes
On Error Resume Next
shape.Ungroup
Next
Next
cursld = cursld + 1
Loop
'Start looking through each slide
For Each sld In .Slides
Print #2, "------------Slide " & sld.SlideNumber & "------------"
'check if hidden
If sld.SlideShowTransition.Hidden = msoTrue Then
hidsld = hidsld + 1
Print #2, vbTab & "-Is Hidden "
Else: Print #2, vbTab & "-Is vsible"
End If
'check for speaker note
If sld.NotesPage.Shapes(2).TextFrame.TextRange.Text <> "" Then
If sld.NotesPage.Shapes(2).TextFrame.TextRange.Characters.Count > 1 Then
totnote = totenote + 1
Print #2, vbTab; "-Has speaker notes"
End If
Else: Print #2, vbTab & "-No speaker notes"
End If
'check for comments
If sld.Comments.Count > 0 Then
totcom = totcom + 1
For Each com In sld.Comments
sldcom = sldcom + 1
Next
Print #2, vbTab & "-Has " & sldcom & " comments"
sldcom = 0
Else: Print #2, vbTab & "-Has no comments"
End If
'start checking shapes
For Each shape In sld.Shapes
'Check for pictures/dead images
If InStr(1, shape.Name, "Picture") <> 0 Then
sldpic = sldpic + 1
End If
'check for charts (which could have embedded Excels)
If shape.HasChart Then
sldchart = sldchart + 1
End If
'check for embedded media
If shape.Type = msoMedia Then
If shape.MediaType = ppMediaTypeMovie Then
Debug.Print ("movie")
sldmov = sldmov + 1
ElseIf shape.MediaType = ppMediaTypeSound Then
Debug.Print ("sound")
sldsound = sldsound + 1
ElseIf shape.MediaType = ppMediaTypeMixed Then
Debug.Print ("mixed") 'the f*** is this?
ElseIf shape.MediaType = ppMediaTypeOther Then
Debug.Print ("Other") 'the f*** is that?
End If
End If
Next
'check and print shape chck results
If sldchart > 0 Then
totchart = totchart + 1
Print #2, vbTab & "-There are " & sldchart & " charts with an embedded Excel."
Else: Print #2, vbTab & "-No chart present."
End If
If sldpic > 0 Then
totpic = totpic + 1
Print #2, vbTab & "-Has " & sldpic & " pictures that might contain text."
Else: Print #2, vbTab & "-No images present"
End If
'check for hyperlinks (skips links to other parts of the presentation)
If sld.Hyperlinks.Count > 0 Then
For Each hyp In sld.Hyperlinks
If hyp.Address <> "" Then
hypsld = hypsld + 1
End If
Next
End If
If hypsld > 0 Then
tothyp = tothyp + 1
Print #2, vbTab & "-Has " & hypsld & " hyperlinks."
Else: Print #2, vbTab & "-No Hyperlinks."
End If
sldpic = 0
sldchart = 0
hypsld = 0
Next
.Close
End With
pog: filepath = Dir 'clear filepath so that it can loop to the next one
Print #1, _
hidlsd & " hidden slides" & vbLf _
; totnote & " slides with speaker notes" & vbLf _
; totcom & " slides with comments" & vbLf _
; totpic & " slides with dead images" & vbLf _
; totchart & " slides with charts" & vbLf _
; tothyp & " slides with hyperlinks"
Close #1
Close #2
Loop
End Sub
ppMediaTypeMixed可能只适用于ShapeRange对象，而不是单个形状。如果插入视频和声音文件，则同时选择两者，然后单击
MsgBox ActiveWindow.Selection.ShapeRange.MediaType
会告诉你它是-2或ppMediaTypeMixed。我怀疑你不会从单个形状中得到这个结果，即使你把vid和sound形状组合在一起，这个组也不会是一个媒体对象。