I am duplicating with minor date changes, slideshows created by another user, who constantly forgets to embed audio, but links it instead.
Is there some simple way to determine whether audio is embedded or linked, and what the source file path is, if it is linked? If I could run a macro to just determine this it would help enormously.
Not sure how to approach this, but individually opening dozens of files to determine audio is there defeats everything else that is scripted in this case.
This is the way I would do it:
Sub DetermineAudioLinks()
Dim p As Presentation: Set p = ActivePresentation
Dim s As Slide
Dim sh As Shape
For Each s In p.Slides
For Each sh In s.Shapes
If sh.Type = msoMedia Then
If sh.MediaType = ppMediaTypeSound Then
Debug.Print "Slide " & s.SlideNumber & ":" ; sh.Name
If sh.MediaFormat.IsLinked Then
Debug.Print vbTab & "Is Linked: True"
Debug.Print vbTab & sh.LinkFormat.SourceFullName
End If
End If
End If
Next
Next
End Sub
Note the the MediaFormat property above is PowerPoint 2010 only - it won't work with earlier versions of PowerPoint.
Related
I've been working on a VBA macro that automatically creates watermark on a master slide for multiple named people and then automatically saves it to separate PDFs. All of this works well now. However, some presentations I may need to watermark, have multiple themes applied to different slides. (eg. first half is using theme 1 and the second half is using theme 2) Each theme has a separate master slide. When I use ActivePresentation.SlideMaster, this only affects the top master slide in the Slide Master view. How would I go about accessing master slides for the other themes?
Edit: Here is the code I have. The xlVariables come from an Excel file. The watermark line refers to the text box that is put furthest back. I searched for a way to access multiple master slides but I couldn't find anything on it.
xlName = Range("A" & CStr(count))
xlCompany = Range("B" & CStr(count))
xlDate = Range("C" & CStr(count))
xlMail = Range("D" & CStr(count))
'Create the watermark
ActivePresentation.SlideMaster.Shapes(1).TextFrame.TextRange.text = "Confidential - Do Not Share" & vbNewLine & "Issued to " _
& xlName & vbNewLine & "on " & xlDate & vbNewLine & xlCompany & " - Internal Use Only"
Here's some sample code that will do something (that you define) to each master (oDes.SlideMaster in the code) and layout (oLay) in a presentation.
Modify DoSomethingWithShapeContainer to do whatever it is you need to do to each master/layout.
Sub AllMastersAndLayouts()
Dim oLay As CustomLayout
Dim oDes As Design
With ActivePresentation
For Each oDes In .Designs
Call DoSomethingWithShapeContainer(oDes.SlideMaster)
For Each oLay In oDes.SlideMaster.CustomLayouts
Call DoSomethingWithShapeContainer(oLay)
Next
Next
End With
End Sub
Sub DoSomethingWithShapeContainer(oShapeContainer As Object)
With oShapeContainer.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 200, 50)
.TextFrame.TextRange.Text = "I did something here"
End With
End Sub
I need to loop over some word documents, and extract images from a word document and save them in a separate folder.
I've tried the method of saving them as an HTML document, but it is not a good fit for my requirement.
Now, I'm looping through the images using inlineshapes object and then copy-pasting them on a publisher document and then saving them as an image. However, I'm facing a Runtime Automation error when I'm running the script.
For using the Publisher runtime library I've tried both early and late binding but I'm facing the error on both of them.
Can anyone please let me know what is the problem? Also, if anyone can explain why I'm facing this error, that'd be great. As per my understanding, it is due to memory allocation, but I'm not sure.
Here is the code block that I've been working on (fp, dp are folder paths, while filename is the word document name. I'm calling this sub in another sub that is looping over all the files in a folder):
Sub test(ByVal fp As String, ByVal dp As String, ByVal filename As String)
Dim doc As Document
Dim pubdoc As New Publisher.Document
Dim shp As InlineShape
'Application.Screenupdating = False
'Dim pubdoc As Object
'Set pubdoc = CreateObject("Publisher.Document")
Set doc = Documents.Open(fp)
With doc
i = .InlineShapes.Count
Debug.Print i
End With
For j = 1 To i
Set shp = doc.InlineShapes(j)
shp.Select
Selection.CopyAsPicture
pubdoc.Pages(1).Shapes.Paste
pubdoc.Pages(1).Shapes(1).SaveAsPicture (dp & Application.PathSeparator & j & ".jpg")
pubdoc.Pages(1).Shapes(1).Delete
Next
doc.Close (wdDoNotSaveChanges)
pubdoc.Close
'Application.Screenupdating = True
End Sub
Apart from this, if anyone has any suggestions to make this faster, I'm all ears. Thanks in advance!
Just add .zip to the end of the file name, expand the file and look in the word/media folder. All the files will be there, no programming necessary.
Extracting the pictures from a Filtered HTML document that was created from your original source document would be faster. However, you said that was not a good fit for you needs so ... here is example code that will locate pictures in your source document and paste them into a second document.
The speed problem of this type of code is caused by the CopyPicture working from a Selection command, so I recommend using a range instead. Of course the For/Next loop that is required is slower no matter what.
Sub CopyPasteAsPicture()
Dim doc As Word.Document, iShp As Word.InlineShape, shp As Word.Shape
Dim i As Integer, nDoc As Word.Document, rng As Word.Range
Set doc = ActiveDocument
If doc.Shapes.Count > 0 Then
For i = 1 To doc.Shapes.Count
Set shp = doc.Shapes(i)
If shp.Type = msoLinkedPicture Or shp.Type = msoPicture Then
'if you want only pictures extracted then you have
'to specify the type
shp.ConvertToInlineShape
'if you want all extracted pictures to be in the sequence
'they appear in the document then you have to convert
'floating shapes to inline shapes
End If
Next
End If
If doc.Content.InlineShapes.Count > 0 Then
Set nDoc = Word.Documents.Add
Set rng = nDoc.Content
For i = 1 To doc.Content.InlineShapes.Count
doc.Content.InlineShapes(i).Range.CopyAsPicture
rng.Paste
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
rng.Paragraphs.Add
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
Next
End If
End Sub
If you want to place all shapes (floating or inline) into a folder as image files, then the best way is to save the source document as a filtered HTML document. Here is the command:
htmDoc.SaveAs2 FileName:=LGPWorking & strFileName, AddToRecentFiles:=False, FileFormat:=Word.WdSaveFormat.wdFormatFilteredHTML
In the above the active document is assigned to the variable htmDoc. I am giving this new document a specific name and location. The output from this is not only the HTML file but also a directory by the same name with an appended "_Files" label. In the "x_Files" directory are all the image files.
If you only want selective images pulled from your original source document, or if you want images pulled from multiple source documents ... then you need to use the above code that I shared for placing only the images you want from one or more source document into a new Word document and then save that new document as an Filtered HTML.
When your routine is done, you can Kill the HTML document and only leave the Files directory.
I had to change a few things around, but this will allow to save a single image on a word document and go through a couple of cycles before it turns into a jpg on the other side, without any white space
filename = ActiveDocument.FullName
saveLocaton = "z:\temp\"
FolderName = "test"
On Error Resume Next
Kill "z:\temp\test_files\*" 'Delete all files
RmDir "z:\temp\test_files" 'Delete folder
ActiveDocument.SaveAs2 filename:="z:\temp\test.html", FileFormat:=wdFormatHTML
ActiveDocument.Close
Kill saveLocaton & FolderName & ".html"
Kill saveLocaton & FolderName & "_files\*.xml"
Kill saveLocaton & FolderName & "_files\*.html"
Kill saveLocaton & FolderName & "_files\*.thmx"
Name saveLocaton & FolderName & "_files\image00" & 1 & ".png" As saveLocaton & FolderName & "_files\" & test2 & "_00" & x & ".jpg"
Word.Application.Visible = True
Word.Application.Activate
I have a PowerPoint template, which is links up with Excel. Some of the areas in Excel has been copied with links, so that it will automatically update.
Whenever this PowerPoint template will be Saved As, I need to remove these links to external Excel Workbooks.
Is there somehow to do this in PowerPoint just like
Private Sub Workbook_Before Save(ByVal SaveAsUI As Boolean, Cancel As Boolean) in Excel?
So far
I tried the below-mentioned answer, without any luck. The code somehow seems to not run - here I don't know if I'm doing it wrong. I tried running it in a normal module and a class module - without any way of provoking it to happen. Then I tried running it as a normal sub, and here I got errors on the HasRevisionInfoand alsoApplication.PresentationBeforeSave.
Yes there is, look into Application.PresentationBeforeSave event which Occurs before a presentation is saved.
Here is vb example
Private Sub PPTApp_PresentationBeforeSave(ByVal Pres As Presentation, _
Cancel As Boolean)
Dim intResponse As Integer
Set Pres = ActivePresentation
If Pres.HasRevisionInfo Then
intResponse = MsgBox(Prompt:="The presentation contains revisions. " & _
"Do you want to accept the revisions before saving?", Buttons:=vbYesNo)
If intResponse = vbYes Then
Cancel = True
MsgBox "Your presentation was not saved."
End If
End If
End Sub
I got it to work after a lot of research, #0m3R provided me with some of the right answer.
Somehow I found somewhere, that I had to combine a class module with a regular module.
Here's the code for the Class Module:
Private Sub PPTApp_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)
Dim sld As Slide
Dim shp As Shape
Dim TextValue As String
Dim intResponse As Integer
Set Pres = ActivePresentation
TextValue = "You're about to save this PowerPoint." & Chr(10) & "This Powerpoint is programmed to break all links" & _
" meaning that all of the content will not be updated automatically anymore." & Chr(10) & Chr(10) & _
"Do you wish to break all links?"
If Pres.Name <> "A3.potm" Then
intResponse = MsgBox(TextValue, Buttons:=vbYesNo)
If intResponse = vbYes Then
For Each sld In Pres.Slides
For Each shp In sld.Shapes
On Error Resume Next
shp.LinkFormat.BreakLink
On Error GoTo 0
Next shp
Next sld
Else
MsgBox "You didn't break all links - the presentation may be overwritten in the future..."
End If
End If
End Sub
Here's the code for the regular Module
Option Explicit
Dim cPPTObject As New cEventClass
Sub InitializeApp()
Set cPPTObject.PPTApp = Application
End Sub
I chose to make a "Command Button" in my PowerPoint, to have the user run a code before viewing the presentation. Then whenever they will save this presentation, the have to choose if they want to delete the links or not :)
Thank you for your assistance :)
We insert and link pictures (insert picture from file .emf) in our Word documents (.docx). Our documents and the graphic files are stored on our network drives. We then provide our documents to the authors to be worked on. The pictures in the documents are useful for the authors.
How do I programmatically and globally (document wise, not batch processing documents): Extract the filename (without the file extension) of the pictures linked and inserted?
We have a tool that exports the Word document .docx to .XML.
Ps: I googled for possible/potential VBA solutions. So far, I gather:
there’s no way one can be sure / check that the pictures have been linked and inserted properly / correctly in a .docx
there’s no way to view the source code (? at least I tried Alt+ F9 / Shift+F9)
Or is macro/ vba not the way to go?
Specs:
Word 2013.
64 bit
Graphic format. Emf
Graphic and word documents store on a network drive
Graphics not inserted and linked via the INCLUDEPICTURE field.
To get a listing of floating and inline linked pictures alike, you might use code like:
Sub Demo()
Dim Shp As Shape, iShp As InlineShape, StrOut As String
With ActiveDocument.Range
StrOut = "Linked Shapes:"
For Each Shp In .ShapeRange
With Shp
If .Type = msoLinkedPicture Then
StrOut = StrOut & Chr(11) & Split(.LinkFormat.SourceName, ".")(0)
End If
End With
Next
If InStr(StrOut, Chr(11)) = 0 Then StrOut = StrOut & " None."
.InsertAfter vbCr & StrOut
StrOut = "Linked InlineShapes:"
For Each iShp In .InlineShapes
With iShp
If .Type = wdInlineShapeLinkedPicture Then
StrOut = StrOut & Chr(11) & Split(.LinkFormat.SourceName, ".")(0)
End If
End With
Next
If InStr(StrOut, Chr(11)) = 0 Then StrOut = StrOut & " None."
.InsertAfter vbCr & StrOut
End With
End Sub
Do note that the above code only searches the document body; not headers, footers, etc. The listings are output at the end of the document.
Graphics formatted with text wrappping fall into the Shapes collection. These cannot use IncludePicture to manage the link - they "live" in a different layer of the document than text and field codes. So the only way to access or manage this information is through the object model (VBA, for example), or through the Word Open XML.
The object model provides the LinkFormat property for the Shape object to query and manage link information. Among other things, there are properties and methods for breaking the link, getting the file name, the file path and the complete file information.
The following loops all Shape objects in the main body of the document and tests whether the type is a linked picture. If it is, the full file information is assigned to sSource.
Sub GetSourceFromLinkedShape()
Dim shp As Word.Shape
Dim sSource As String
For Each shp In ActiveDocument.shapes
If shp.Type = msoLinkedPicture Then
sSource = shp.LinkFormat.SourceFullName
End If
Next
End Sub
I have Word survey files, each containing forms filled by subjects. Until now I have manually exported the forms data by saving as txt and choosing the option "save form data as delimited text file".
I want to programmatically save as delimited text file all the .doc documents in a given directory. Alternatively, if this were to be too complicated, it would be sufficient to save one file at a time. The new txt files must have the same name as the original .doc files.
Thanks for your input Jan Schejbal. I've reached a solution with this piece of code, so I share it for whose who encounter the same problem. I received help from here
Sub Save_Forms_Data()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, strDocName As String
strFolder = CurDir
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
strDocName = Left(.FullName, InStrRev(.FullName, ".")) & "txt"
.SaveAs2 FileName:=strDocName, FileFormat:=wdFormatText, AddToRecentFiles:=False, _
SaveFormsData:=True, Encoding:=1252, InsertLineBreaks:=False, LineEnding:=wdCRLF
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
You can record a macro, which means you start the recording, do certain actions, then stop the recording, and VBA code for said actions is automatically generated. The code may not be very clean, but it should give you a good start to show you how the syntax looks and what commands you need for your actions. For certain things (e.g. dynamically specifying the file name), you will need to consult the documentation, but if you have any programming experience in any common language, this should not pose a significant problem once you have the "skeleton" provided by the macro recorder.
The more you want to automate, the more VBA you will need to learn. As VBA really isn't difficult, and it seems like you have a lot of repetitive work in front of you if you don't automate it, I'd suggest you learn it and Google what you need. This way, you will get your work done in a similar timeframe (or less, especially if this is not just a one-off thing), you will have a macro to do it next time, it will be less boring, and you will have learned a bit of VBA.