论坛的长期用户,但我第一次实际上是在问一些事情,所以如果我做错了什么,请告诉我。
所以我正在编写一个 Powerpoint 宏,它基本上只是遍历给定路径中的所有 Powerpoint 文件,然后遍历并检查可能感兴趣的任何内容。
我的代码运行良好,因此不需要真正的帮助,但有一次我正在使用 shape.mediatype
属性检查嵌入的视频或声音。
问题是,我发现这个 https://docs.microsoft.com/en-us/office/vba/api/powerpoint.ppmediatype 知道我可以期待找到什么这个属性,但我不知道 ppMediaTypeMixed
或 ppMediaTypeOther
在现实世界中实际上是什么,不幸的是微软只是告诉我“这是混合媒体!”也没有真正的帮助。
如果有人能让我知道这两个实际代表什么,我将不胜感激。
如果有人感兴趣,宏的代码如下(仍然是一个 WIP,我只是在几个月前通过自学开始 vba 所以不要太难判断它)
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 'this is really only for testing cause I actually can't be f***** to delete the folders every time since it overwrites the files
MkDir (fldpath & "Detailled reports")
MkDir (fldpath & "Short Summary reports")
Shortsum = fldpath & "Short Summary reports\ShortSum_" & filepath & ".txt"
Longsum = fldpath & "Detailled reports\DetailRep_" & 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
回答1
ppMediaTypeMixed 应该只适用于 ShapeRange 对象,而不是单个 Shapes。如果插入视频和声音文件,则同时选择两者,然后
MsgBox ActiveWindow.Selection.ShapeRange.MediaType
会告诉你它是 -2 或 ppMediaTypeMixed。我怀疑您是否会从单个形状中获得此结果,即使您将 vid 和声音形状分组,该组也不会是媒体对象。