I like to create an empty pdf file. I have the following code:
Sub CreateEmptyPDF()
Dim AcroApp As Object
Set AcroApp = CreateObject("AcroExch.App")
Dim PDFDoc As Object
Set PDFDoc = CreateObject("AcroExch.PDDoc")
' Create a new PDF document with a single blank page??
PDFDoc.Create
PDFDoc.InsertPages PDFDoc.GetNumPages - 1, PDFDoc, 1, 1, 1
' Save the document to a file
PDFDoc.Save PDSaveFull, "C:\temp\Empty_page.pdf"
' Close the document and release resources
PDFDoc.Close
AcroApp.Exit
End Sub
THe code is creating the file but when I open it I have:
This file cannot be opened becuse it has no pages.
I play with the arguments from this but without succes
PDFDoc.InsertPages PDFDoc.GetNumPages - 1, PDFDoc, 1, 1, 1
Related
I am trying to create a VB Code that will create number of slides based on the audio files in the folder.
Then, I want to insert random background images from the folder.
I have written this code but it doesn't work.
Sub CreatePowerPointSlides()
'Declare variables
Dim pptApp As Object
Dim pptPres As Object
Dim pptSlide As Object
Dim audioFiles As String
Dim audioFile As String
Dim imageFiles As String
Dim imageFile As String
'Create a new instance of PowerPoint and open the presentation
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Add
'Get a list of all audio files in the folder
audioFiles = Dir("C:\Users\audio\*.mp3")
'Iterate through each audio file in the folder
Do While audioFiles <> ""
audioFile = audioFiles
'Create a new slide in PowerPoint and add the audio file
Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count + 1, 11, ppViewSlide)
pptSlide.Shapes.AddMediaObject2 FileName:=audioFile, LinkToFile:=msoFalse,
SaveWithDocument:=msoTrue
'Get a list of all image files in the folder
imageFiles = Dir("C:\Users\user1\Pictures\ImageBackground\Nature\*.jpg")
'Choose a random image file from the folder
Randomize
imageFile = "C:\Users\user1\Pictures\ImageBackground\Nature\" &
Split(imageFiles, vbNewLine)(Int(Rnd() *
UBound(Split(imageFiles, vbNewLine))))
'Add the image file as the background of the slide
pptSlide.FollowMasterBackground = msoFalse
pptSlide.Background.Fill.UserPicture PictureFile:=imageFile
'Get the next audio file in the folder
audioFiles = Dir()
Loop
pptApp.ActiveWindow.View.Type = ppViewSlide
End Sub
It doesn't even create one slide.
I am trying to automate Powerpoint presentation. I found a code on the internet. This code is working well, but it works with the static path in the code. I want to implement it using OpenFolder Dialogue Box. The idea is as, When I click the button import picture, the file dialogue box should be open and I select the folder. The pictures within the folder automatically and the size of the picture should automatically fit the slide. When this process complete, the slide show automatically starts to display the picture using fade animation. The code is as under.
Sub main()
Dim i As Integer
Dim arrFilesInFolder As Variant
arrFilesInFolder = GetAllFilesInDirectory("C:\Users\Admin\OneDrive\Pictures\Screenshots")
For i = LBound(arrFilesInFolder) To UBound(arrFilesInFolder)
Call AddSlideAndImage(arrFilesInFolder(i))
Next
End Sub
Private Function GetAllFilesInDirectory(ByVal strDirectory As String) As Variant
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim arrOutput() As Variant
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strDirectory)
ReDim arrOutput(0)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file path
arrOutput(i - 1) = objFile.Path
ReDim Preserve arrOutput(UBound(arrOutput) + 1)
i = i + 1
Next objFile
ReDim Preserve arrOutput(UBound(arrOutput) - 1)
GetAllFilesInDirectory = arrOutput
End Function
Private Function AddSlideAndImage(ByVal strFile As String)
Dim objPresentaion As presentation
Dim objSlide As slide
Set objPresentaion = ActivePresentation
Set objSlide = objPresentaion.Slides.Add(1, PpSlideLayout.ppLayoutChart)
Call objSlide.Shapes.AddPicture(strFile, msoCTrue, msoCTrue, 100, 100, 650, 450)
End Function
Please someone guide, where I am doing wrong. Thanks
Looks like you need to replace the hard-coded file path with code that prompts the user for one. Seems Application.FileDialog should get you there:
Dim path As String
With Application.FileDialog(Type:=msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then
path = .SelectedItems(1)
Else
'user cancelled, bail out:
Exit Sub
End If
End With
Dim arrFilesInFolder As Variant
arrFilesInFolder = GetAllFilesInDirectory(path)
'...rest of the code...
I'm getting this error, "Microsoft Excel is waiting for another application to complete an OLE action" when trying to automate a PDF string search and record findings in excel. For certain PDFs this error is not popping. I assume this is due to the less optimized PDFs taking a longer time to search string while indexing page by page.
To be more precise, I have a workbook containing two sheets. One contains a list of PDF file names and the other has a list of words that I want to search. From the file list the macro would open each PDF file and take each word from the list of words and perform a string search. If found it would record each finding in a new sheet in the same workbook with the file name and the found string.
Below is the code I'm struggling with. Any help is welcome.
Public Sub SearchWords()
'variables
Dim ps As Range
Dim fs As Range
Dim PList As Range
Dim FList As Range
Dim PLRow As Long
Dim FLRow As Long
Dim Tracker As Worksheet
Dim gapp As Object
Dim gAvDoc As Object
Dim gPDFPath As String
Dim sText As String 'String to search for
FLRow = ActiveWorkbook.Sheets("List Files").Range("B1").End(xlDown).Row
PLRow = ActiveWorkbook.Sheets("Prohibited Words").Range("A1").End(xlDown).Row
Set PList = ActiveWorkbook.Sheets("Prohibited Words").Range("A2:A" & PLRow)
Set FList = ActiveWorkbook.Sheets("List Files").Range("B2:B" & FLRow)
Set Tracker = ActiveWorkbook.Sheets("Tracker")
'For each PDF file list in Excel Range
For Each fs In FList
'Initialize Acrobat by creating App object
Set gapp = CreateObject("AcroExch.App")
'Set AVDoc object
Set gAvDoc = CreateObject("AcroExch.AVDoc")
'Set PDF file path to open in PDF
gPDFPath = fs.Cells.Value
' open the PDF
If gAvDoc.Open(gPDFPath, "") = True Then
'Bring the PDF to front
gAvDoc.BringToFront
'For each word list in the range
For Each ps In PList
'Assign String to search
sText = ps.Cells.Value
'This is where the error is appearing
If gAvDoc.FindText(sText, False, True, False) = True Then
'Record findings
Tracker.Range("A1").End(xlDown).Offset(1, 0) = fs.Cells.Offset(0, -1).Value
Tracker.Range("B1").End(xlDown).Offset(1, 0) = ps.Cells.Value
End If
Next
End If
'Message to display once the search is over for a particular PDF
MsgBox (fs.Cells.Offset(0, -1).Value & " assignment complete")
Next
gAvDoc.Close True
gapp.Exit
set gAVDoc = Nothing
set gapp = Nothing
End Sub
I have now found the answer to this problem.
I'm using Acrobat Pro and whenever I open a PDF file, it opens with limited features due to Protected View settings. If I disable this function or if I click Enable All Features and save changes to the PDF files, VBA macro runs smooth.
It's funny, I'm posting an answer to my own problem.
I am wondering if anyone has dealt with this before. I have a spreadsheet with links to thousands of pdf files. I would like to load the content of each pdf into a string variable and run a few RegEx to extract useful data. I have the function shown below which loads the content of a pdf file into a string, however this function only works for local files. However in my case I am opening the pdf file using IE.Navigate2 "https://www.example.com/mypdf.pdf" this will open the pdf in the browser, how can I load the content of that file into a string. The extreme solution would be to download the file and open it with the function below and then delete it. Please let me know your thoughts. Please note that the function below will only work if you have Acrobat installed (not the reader) you will also will need to add the reference in the VBA project to Adobe Acrobat Type Library
Public Function ReadAcrobatDocument(strFileName As String) As String
Dim AcroApp As CAcroApp, AcroAVDoc As CAcroAVDoc, AcroPDDoc As CAcroPDDoc
Dim AcroHiliteList As CAcroHiliteList, AcroTextSelect As CAcroPDTextSelect
Dim PageNumber, PageContent, Content, i, j
Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
If AcroAVDoc.Open(strFileName, vbNull) <> True Then Exit Function
' The following While-Wend loop shouldn't be necessary but timing issues may occur.
While AcroAVDoc Is Nothing
Set AcroAVDoc = AcroApp.GetActiveDoc
Wend
Set AcroPDDoc = AcroAVDoc.GetPDDoc
For i = 0 To AcroPDDoc.GetNumPages - 1
Set PageNumber = AcroPDDoc.AcquirePage(i)
Set PageContent = CreateObject("AcroExch.HiliteList")
If PageContent.Add(0, 9000) <> True Then Exit Function
Set AcroTextSelect = PageNumber.CreatePageHilite(PageContent)
' The next line is needed to avoid errors with protected PDFs that can't be read
On Error Resume Next
For j = 0 To AcroTextSelect.GetNumText - 1
Content = Content & AcroTextSelect.GetText(j)
Next j
Next i
ReadAcrobatDocument = Content
AcroAVDoc.Close True
AcroApp.Exit
Set AcroAVDoc = Nothing: Set AcroApp = Nothing
End Function
I have a few .jpg files in C:\my_folder
Here are their names: pic_1.jpg , pic_2.jpg , pic_3.jpg , pic_4.jpg , pic_5.jpg .
What command or a group of commands in Power Point VBA should I use in order to be able to automatically create several frames in PowerPoint so that each frame would contain one picture?
This VBScript creates a new PowerPoint presentation and adds two slides to it, each with a picture. You will need to adjust the picture's location and size to suit your taste. Also you'll need to utilize the Scripting.FileScriptingObject to enumerate your images if you want to automatically grab whatever pictures exist in a directory for embedding into the presentation. If you want your script can also save the presentation by calling pptPresentation.SaveAs after your slides are generated.
The MSDN documentation is located at http://msdn.microsoft.com/en-us/library/ff746873.aspx.
Dim pptDoc
Dim pptPresentation
Dim pptSlide
Set pptDoc = WScript.CreateObject( "PowerPoint.Application" )
pptDoc.Visible = True
Set pptPresentation = pptDoc.Presentations.Add( True )
' Add a new slide with a blank layout to the end of the Slides collection
' 12 = ppLayoutBlank
Set pptSlide = pptPresentation.Slides.Add( pptPresentation.Slides.Count + 1, 12 )
' Add a picture into the slide, saving the picture into the PowerPoint document
' 10, 10 are the Left and Top coordinates respectively
pptSlide.Shapes.AddPicture "c:\FullPath\1.JPG", False, True, 10, 10
' Add another slide with a picture
Set pptSlide = pptPresentation.Slides.Add( pptPresentation.Slides.Count + 1, 12 )
pptSlide.Shapes.AddPicture "c:\FullPath\2.jpg", False, True, 10, 10
As the previous answer was specific to VBS scripting, here is a version for embedding into PowerPoint as a VBA macro. This was created with PowerPoint 2010.
This has the directory hard-coded so it's an exercise for the reader to prompt for a directory name to scan.
Sub CreatePictureSlideshow( )
Dim presentation
Dim layout
Dim slide
Dim FSO
Dim folder
Dim file
Dim folderName
' Set this to point at the folder you wish to import JPGs from
' Note: make sure this ends with a backslash \
folderName = "c:\somedirectory\"
' Delete all slides and setup variables
Set presentation = Application.ActivePresentation
If presentation.Slides.count > 0 Then
presentation.Slides.Range.Delete
End If
Set layout = Application.ActivePresentation.SlideMaster.CustomLayouts(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
' Retrieve the folder's file listing and process each file
Set folder = FSO.GetFolder(folderName)
For Each file In folder.Files
' Filter to only process JPG images
If LCase(Mid(file.Name, Len(file.Name) - 3, 4)) = ".jpg" Then
' Create the new slide and delete any pre-existing contents
Set slide = presentation.Slides.AddSlide(presentation.Slides.count + 1, layout)
While slide.Shapes.count > 0
slide.Shapes(1).Delete
Wend
' Add the picture
slide.Shapes.AddPicture folderName + file.Name, False, True, 10, 10
' Optional: create a textbox with the filename on the slide for reference
' Dim textBox
' Set textBox = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 200, 200)
' textBox.TextFrame.TextRange.Text = file.Name
End If
Next
End Sub