Running VBA code on external powerpoint file - vba

I want to run VBA code from a certain powerpoint file on an external powerpoint file without copying the code into the external powerpoint file. I wish to only open the original powerpoint file containing the code and run it from there, it should point to the external powerpoint file and alter it directly. How to do this?
So far I am doing it like this:
'For each file, if powerpoint run remove alt text macro
For Each FSOFile In FSOFolder.Files
'Insert the actions to be performed on each file
sFileExtension = FSOFile.GetExtensionName()
If sFileExtension = "pptm" Or sFileExtension = "pptx" Or sFileExtension = "ppt" Then
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Presentations.Open (FSOFile.Path)
' Note that the file name and the module
' name are required to path the macro correctly.
PPT.Run (ActivePresentation.Path + "!Module1.BlankAllTheAltText")
filesAltered = filesAltered + 1
End If
Next
I don't think this is correct. Any suggestions?

Since you're already running this from within PPT, you don't need to create a PPT application object. Try something more like this:
Dim oPres As Presentation
'For each file, if powerpoint run remove alt text macro
For Each FSOFile In FSOFolder.Files
'Insert the actions to be performed on each file
sFileExtension = FSOFile.GetExtensionName()
If sFileExtension = "pptm" Or sFileExtension = "pptx" Or sFileExtension = "ppt" Then
Set oPres = Presentations.Open(FSOFile.Path)
' Alter BlankAllTheAltText to take a presentation object
' as a parameter
Call BlankAllTheAltText(oPres)
filesAltered = filesAltered + 1
oPres.Save
oPres.Close
End If
Next

Related

Apply template to powerpoint in Excel VBA from embedded template file

I'm trying to apply a template to a powerpoint through excel. The powerpoint template is embedded within my excel file via insert -> Object. I've successfully used the .applytemplate method to apply a template from file, but I cannot adjust the code to reference the embedded powerpoint template. I tried using OLEObject, but I'm afraid that isn't correct. Please review below code.
Sub ppCreate()
Dim myPP As PowerPoint.Application
Dim myPres As PowerPoint.Presentation
Dim activeSlide As PowerPoint.Slide
Dim ppObj As OLEObject
' Create instance of PowerPoint
Set myPP = CreateObject("Powerpoint.Application")
' For automation to work, PowerPoint must be visible
myPP.Visible = True
' Create a presentation
Set myPres = myPP.Presentations.Add
' Set slide view to Slide Only
myPP.ActiveWindow.ViewType = ppViewSlide
'Resize to 4:3
myPres.PageSetup.SlideSize = 2
'Add a slide
Set activeSlide = myPres.Slides.Add(1, ppLayoutBlank)
'Import Template
Worksheets("CBRDATA").Select
Set ppObj = ActiveSheet.OLEObjects("ppObj") 'NOT WORKING
myPres.ApplyTemplate (ppObj) 'NOT WORKING
myPres.ApplyTemplate "C:\CBR_TEMPLATE_COVER.potx" 'WORKING
Worksheets("CBR").Select
End Sub
Update:
'Test if template exists in C:\
If Dir("C:\CBR_TEMPLATE_COVER.potx") = "" Then
'Open/Save the embedded template to C:\
Set tempPP = CreateObject("Powerpoint.Application")
Worksheets("CBRDATA").OLEObjects("ppObj").Verb 0
tempPP.Visible = True
Set tempPres = tempPP.ActivePresentation
tempPres.SaveCopyAs ("C:\CBR_TEMPLATE_COVER.potx")
tempPres.Close
Else:
End If
' Create instance of PowerPoint
Set myPP = CreateObject("Powerpoint.Application")
This doesn't work because ActiveSheet.OLEObjects("ppObj") is type OLEObject, not PowerPoint.Presentation.
Set ppObj = ActiveSheet.OLEObjects("ppObj") 'NOT WORKING
While manually double-clicking on the object open the POTX file (actually it opens a new blank PPTX using the POTX as template), your assignment statement above isn't doing any of that, it's trying instead to put an OLEObject where a Presentation is expected, and that will always fail.
So, how to "open" the OLEObject? OLEObject has a .Verb method, and the following will perform the object's default action, which in the case of embedded package objects, is usally to "open" them.
The Solution
'Import Template
'## This should Open the template
Worksheets("CBRDATA").OLEObjects("ppObj").Verb 0
'## Assign the ActivePresentation to your ppObj variable
Set ppObj = myPP.ActivePresentation
Editorializing: Embedded OLEObjects are notoriously problematic, and probably not an ideal place to story things like document templates :)

Save Excel Sheet text only to text file VBA

I am trying to copy the values of one column in a sheet to a text file. The code I currently have causes runtime error 434.
Sheets("Output to fcf.1").Columns("A").SaveToText "P:\4_Calcs\02. Flag Mapping\test_.txt"
If I try and save the whole sheet
Sheets("Output to fcf.2").SaveToText "P:\Clear Project Drive\CLE10276 AWS SMP Model Assessmnts\4_Calcs\02. Flag Mapping\test2_.txt"
I get the entire sheet converted into text rather than just the text in the sheet. Is there a simple way to do this?
Thanks in advance!
Not sure which Excel version you have but I don't see a method for SaveToText.
But this procedure should work, or at least get you started...
Sub SaveColumn(sheetName As String, columnName As String, fileName As String)
Dim cell
Dim fso
Dim file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile(fileName, True)
For Each cell In Sheets(sheetName).Columns(columnName).Cells
If cell.Value <> "" Then
file.WriteLine cell.Value
End If
Next
file.Close
Set file = Nothing
Set fso = Nothing
End Sub
To call it...
SaveColumn "Output to fcf.1", "A", "P:\4_Calcs\02. Flag Mapping\test_.txt"
This is designed to be used as a macro.
Step by step guide:
1) From excel, hit Alt+F11 on your keyboard.
2) From the menu bar, click Insert, then Module
3) Copy and paste the code provided below into the new module that opens.
NOTE: DocPath = "C:\docs\data.txt" should be wherever you want the output file saved, including the file's actual name. Remember, the folder you want the output file to be located in should ALREADY exist. This does not create the folder if it can't be found.
4) From the menu bar, click Tools, then References. Make sure both "Microsoft Office 14.0 Object Library" as well as "Microsoft Word 14.0 Object Library" are checked, and hit okay (See screenshot for details)
5) Save the document as an .xlsm file (This file type supports Macros)
6) Close the VBA editor. Back in Excel, on the ribbon click View and then Macros. Your new macro should be in the list as ExportToTXT
7) Select it and hit run.
Sub ExportToTXT()
Dim DocPath As String
Dim MsgBoxCompleted
Columns("A").Select
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = False
Selection.Copy
DocPath = "C:\docs\data.txt"
'Create and save txt file
AppWord.Documents.Add
AppWord.Selection.Paste
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
Application.CutCopyMode = False
AppWord.Quit (wdDoNotSaveChanges)
Set AppWord = Nothing
MsgBoxCompleted = MsgBox("Process complete.", vbOKOnly, "Process complete")
End Sub
Good luck, and if you have any questions, don't hesitate to ask.
NOTE: These directions might seem overly simplified for your skill level, but I wrote the answer like this to potentially help others in the future.
EDIT
Change
DocPath = "C:\docs\data.txt"
to
DocPath = "C:\docs\data.fcf"
And change
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
to
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath
The output file will be .fcf format. Whether or not it will open properly is something I'm not sure of. You'd have to test in the program you're using.

Using excel as inputfile in vba (scripting - non MS OFFICE)

I'm developing a script in VBA (inside a workspace, not MS office program) that needs to use a small excel file as input. I want to use the data in the excel file and load it into a 2D array so that I can make decisions within my script based on this data.
I've tried to google this problem but generally I find problems within excel, but I haven't had any luck finding anything for vba scripting outside MS office.
Can I just use a .Xlsx as inputfile?
How do I put this data into a 2d array? My file only has 11 rows & 2 columns.
Thank you for your time.
This is confusing. VBA = MS Office VBA, as far as I know. Do you mean VB.NET? VBS? Anyway, to extract data from an xlsx file without opening it in Excel, you either need to unzip it and dig through the XML files inside, or use Office Open XML SDK or any other package like that.
Open XML SDK
Office Open XML fileformat
I think this will also work for Visual Basic [for Applications]; I tried it in Excel VBA and Word VBA:
In VBA Development Environment, select Tools, References. In the list that now appears, check the Object Model you need. In your case you will want to check the Microsoft Excel 12.0 Object Library.
You now have access to the complete Excel Object Model in your application and can open and manipulate an Excel spreadsheet file as you need.
The following code in VB for Word opens an Excel Spreadsheet and gets the value of the first cell:
Sub ExcelTestInWord()
Dim oExcel As Object
Dim wb As Object
Dim v
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Set oExcel = CreateObject("Excel.Application")
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If (fd.Show = -1) Then
For Each vrtSelectedItem In fd.SelectedItems
Set wb = oExcel.Workbooks.Open(vrtSelectedItem)
v = wb.Sheets(1).Cells(1).Value
wb.Close
Next vrtSelectedItem
End If
End Sub
Consider the VBScript code below as an example, save it as .vbs file to launch:
Option Explicit
Dim strSourceFilePath, strSourceSheetName, strSourceRange, arrData, strResult, i, j
' set initial data
strSourceFilePath = "C:\Test\data.xlsx"
strSourceSheetName = "input"
strSourceRange = "A1:B11"
' get 2-dimensional array from Excel sheet
With CreateObject("Excel.Application")
.Visible = False
.DisplayAlerts = False
With .Workbooks.Open(strSourceFilePath)
arrData = .Sheets(strSourceSheetName).Range(strSourceRange).Value
.Close
End With
.Quit
End With
' array output for debug purposes
strResult = ""
For j = 1 To UBound(arrData, 1)
For i = 1 To UBound(arrData, 2)
strResult = strResult & arrData(j, i) & ";" & vbTab
Next
strResult = strResult & vbCrLf
Next
WScript.Echo strResult

copy formatted text into access using vba

I need to save formatted text from Word in an Access Database.
So far I've managed to figure out how to store formatted text in an Access Field (Create a Memo Field in a Table and set the Text Format as Rich Text). Searching SO I have not yet come across a solution as to how to transport said text from word into Access.
I know that it is possible, because you can do it by simply copying and pasting the information if you are doing it manually.
My question, how can I copy formatted text from word into a field in a table using VBA?
Experimentally I created the following to test this. So far without success...
Sub GetComments()
'Imports Analyst Comments from Excel files als OLE Objects.
'---------------------------------
'Access Variables
Dim dbsFundDB As DAO.Database
Dim rsComments As DAO.Recordset
Set dbsFundDB = CurrentDb
Set rsComments = dbsFundDB.OpenRecordset("tblFunds")
'Word Variables
Dim doc As Word.Application
Dim dcmt As Word.Document
Dim sectn As Word.Section
Dim obCommentText As Object
Dim sAnalystText As String
'Open New Word File
Set doc = New Word.Application
doc.Visible = True
Set dcmt = doc.Documents.Open(sPathTemplate)
Set sectn = dcmt.Sections(1)
sectn.Range.Select
Selection.InsertFile FileName:="myfile.rtf", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
sAnalystText = sectn.Range.Tables(1).cell(1, 1).Range.FormattedText
rsComments.AddNew
rsComments![Long Comment Exec] = sAnalystText
rsComments.Update
sectn.Range.Select
dcmt.Close savechanges:=False
doc.Quit
End Sub
UPDATE
I tried implementing the answer from Matt Hall. While the text is indeed copied to the database, it does not yet keep the formatting:
Here is my implementation as a simple test:
Option Explicit
Public Const sPathTemplate As String = "W:\L\BDTP\Products\FundResearchTool\Advisory.docx"
Option Compare Database
Sub GetComments()
'Imports Comments from word and save in DB
'Test soubroutine
'---------------------------------
'Word Variables
Dim obCommentText As Variant
Dim strSQL As String
obCommentText = GetWordContent(sPathTemplate)
strSQL = "insert into [tblText]([TestField]) values('" & obCommentText & "')"
DoCmd.RunSQL strSQL
MsgBox "Import Successful", vbInformation Or vbOKOnly
End Sub
Private Function GetWordContent(strFile As String) As Variant
' This function takes the path obtained to the MS-Word Document selected in
' the FileToOpen function and then uses that to open that MS-Word Document
' and retrieve its text contents
Dim objDoc As Word.Document
Set objDoc = GetObject(strFile)
GetWordContent = CVar(objDoc.Sections(1).Range.Text)
objDoc.Close
End Function
Here's a method that heavily references this.
Before you start make sure you have these (or your Access version's equivalent) references ticked in VBA editor > Tools > References:
Microsoft Word 15.0 Object Library
Microsoft Office 15.0 Object Library
Assuming you've set up a form with a command button to trigger this MS-Word import, put the following function and subroutine somewhere in that form's VBA module:
1) File Picker Function:
This will allow you to select the MS-Word Document you want to using the old familiar file dialogue window you see throughout Windows. Ultimately, all it does is save the file path and name of the file you've picked for use in in the subroutine described in (2)...
Private Function FileToOpen() As String
' This function will essentially allow you to browse to MS-Word document
' and then store the path of that file for use in the GetWordContent function
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Select Word document to import"
.Filters.Clear
.Filters.Add "Word files", "*.doc?"
If _
.Show = True _
Then
For Each varFile In .SelectedItems
FileToOpen = varFile
Next
Else
FileToOpen = ""
End If
End With
End Function
2) Get Formatted Text Contents of MS-Word Document Subroutine:
This subroutine will use the file path and name of the MS-Word Document selected in the File Picker function (above) to open the MS-Word document, select all the text, copy it to the clipboard, paste it to a text box on an open form in Access and then close MS-Word...
Private Sub GetWordContent(strFile As String)
' This function takes the path obtained to the MS-Word Document selected in
' the FileToOpen function and then uses that to open that MS-Word Document
' and retrieve its text contents and paste them in to WordDocData textbox on
' the currently open form in Access
' Create an MS-Word Object:
Dim objDoc As Object
Set objDoc = CreateObject("Word.Application")
' Open the file selected in FileToOpen() and copy the contents to clipboard:
With objDoc
.Documents.Open strFile
.Visible = True
.Activate
.Selection.WholeStory
.Selection.Copy
End With
' Set the focus to the WordDocData textbox on the Access Form and paste clipboard:
Me.WordDocData.SetFocus
DoCmd.RunCommand acCmdPaste
Me.WordDocDataSrc = strFile
' Save record on the form:
If _
Me.Dirty _
Then
Me.Dirty = False
End If
' A bit hacky this bit. When you close MS-Word after copying a lot of data,
' you might get a message asking you if you if you want to keep the last item
' you copied. This essentially overwrites the clipboard that currently has
' the whole document stored, to just the first 5 characters, which should allow
' MS-Word to be closed here without a pop-up message to deal with:
With objDoc
.Selection.HomeKey Unit:=wdLine
.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
.Selection.Copy
.Documents.Close
.Quit
End With
Set objDoc = Nothing
End Sub
Your Command Button's On-click Event:
This subroutine should be run from your command button's on-click event. It essentially calls FileToOpen function and the GetWordContent subroutine in order for the user to select a MS-Word Document and then let the VBA copy and paste the formatted text from the MS-Word Document in to a rich text memo textbox on the open form in Access.
Note that this subroutine makes some assumptions, and refers to names of controls/tables/fields and whatnot that you might not have already setup. These assumptions are:
Your form's command button is called cmdGetWordData
Your Access database has a table called tblWordDump
Your form is bound to the table tblWordDump
tblWordDump has 2 memo text fields called WordDocDataSrc and WordDocData to store the imported file path/name and text contents respectively and both are added to your form
Private Sub cmdGetWordData_Click()
' This subroutine runs on your command button; it will call both the FileToOpen function and GetWordContent subroutine
' to retrieve the text contents of your chosen MS-Word Document.
' It will then store both the path the text contents of of your chosen MS-Word Document in 2 fields in a table in Access.
' NOTE: this code assumes that your Access database has:
' - a table called tblWordDump
' - a memo text field in this table called WordDocDataSrc to store the path of MS-Word file imported
' - a memo text field in this table called WordDocData with the TextFormat property set to "Rich Text",
' which will store the text and text formating of the MS-Word file imported
Dim strFile As String
Dim strWordContent As Variant
' Select file via File Dialogue
strFile = FileToOpen
' Conditionals when a file was or wasn't selected
If _
Len(strFile) > 0 _
Then
DoCmd.GoToRecord , , acNewRec
GetWordContent strFile
MsgBox "Import Successful", vbInformation Or vbOKOnly
Else
MsgBox "No File Selected", vbExclamation Or vbOKOnly
End If
End Sub
Here's an example Access file of this for you to poke about in.

PowerPoint VBA: which command (or a set of commands) would create ppt frames out of my .jpg pictures?

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