Long story short, I need to maintain a reference table that maps criteria to the slides where these criteria are addressed. Obviously, this is painful since people will be updating PowerPoints until the very last minute.
My goal is to have a macro that can do the following:
I put all PowerPoint files in a given folder (we'll it .../ImportMe)
Run a script that opens each PowerPoint file.
Makes a list of the Slide#'s in column B
Find the Text Box I'm looking for (These all start with "CT:"). Copy the text and paste it into column C for that respective row.
Put the PowerPoint file name in column A for all applicable rows.
I.e. the below...
I have created code that can get me the slide numbers (and I could get the file name, although I have not done it yet). I'm struggling with copying and pasting the data from a specific textbox (or at all, really) -- this is the portion I want to focus on at the moment...
Set xlSheet = Excel.Application.ActiveWorkbook.Sheets("Reference Table")
pptpath = "C:\Users\Username\ImportMe"
Set PP = CreateObject("PowerPoint.Application")
Set pptPres = PP.Presentations.Open(pptpath)
PP.Visible = msoCTrue
For Each pptSlide In pptPres.Slides
'Find new last row
LastRow = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
xlSheet.Range("B" & NewRow).Value = pptSlide.SlideNumber
For Each pptShape In pptSlide.Shapes
If pptShape.TextFrame2.HasText Then
pptText = pptShape.TextFrame2.TextRange.Text
If InStr(1, pptText, "CT:") > 0 Then
'pptShape.TextFrame2.TextRange.Copy
xlSheet.Range("C" & NewRow).Value = pptText
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Next pptShape
Next pptSlide
pptPres.Close
This just gives me a blank in column C. My impression is that I'm not looping through the PowerPoint "shapes" correctly. I say that because this because it will correctly put the slide #'s in column B.
Please let me know if you have any questions!
Edit to address comment:
Added additional code
The code is hosted in excel
With ".Value" I get that same exact result
***Important Note: I had an error bypass on (not sure why -- this is dumb when testing code). I turned it off and I am getting error...
Run-time error '-2147024893 (80070003)': Method 'Open' of objection 'Presentations' failed
Which doesn't make any sense because the code is able to open the PP and pull the slide #'s.
Related
The following code is intended to update Word bookmarks with formatted data from Excel, however the formatting doesn't come across and unsure why, would appreciate any suggestions. The formatted data is text with certain works underlined.
Set wb = ActiveWorkbook
TodayDate = Format(Date, "mmmm d, yyyy")
Path = wb.Path & "\update_file.docx"
'Create a new Word Session
Set pappWord = CreateObject("Word.Application")
'Open document in word
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Text
End If
Next xlName
Try this instead, using Copy and the (poorly-documented) ExecuteMso method. You need to use Copy against the range (in order to capture formatting) and then you can effectively do the same as the right-click Paste + Keep Source Formatting option:
If docWord.Bookmarks.Exists(xlName.Name) Then
xlName.RefersToRange.Copy
docWord.Bookmarks(xlName.Name).Select
docWord.Application.CommandBars.ExecuteMso "PasteSourceFormatting"
End If
Alternatively, and this might be better because ExecuteMso is asynchronous and can result in timing issues:
xlName.RefersToRange.Copy
docWord.Bookmarks(xlName.Name).Range.PasteAndFormat 16 'wdFormatOriginalFormatting
I have an Excel macro that takes an existing Powerpoint template with chart objects and edits the data for each chart with data from an Excel worksheet. The codes iterates thru 'n' number of rows in worksheet to create a series of 4 slides for each Excel row.
Oddly, for certain rows, one or more slides in the set produces an "Excel has stopped working" error, but the data seems to be installed correctly. However, the problem point is an intermittent and somewhat random "Powerpoint has stopped working" error. The powerpoint error crashes powerpoint entirely. Both seem to occur as I get to around the 50 slide mark or so.
Here is the code for the 4th one in the set as an example. The others are pretty much identical:
oPPT.ActiveWindow.View.GotoSlide Index:=5 + (4 * dIndex)
' SET OBJECT & CHART REFERENCES
Set shapeObject = oPPT.ActivePresentation.Slides(5 + (4 * dIndex)).Shapes("Chart 4")
Set myChart = shapeObject.Chart
Set gChartData = myChart.ChartData
Set gWorkbook = gChartData.Workbook
Set gWorksheet = gWorkbook.Worksheets(1)
' SET VALUES
gWorksheet.Range("B2").Value = myWs.Range("Y" & dRow).Value
gWorksheet.Range("B3").Value = myWs.Range("AA" & dRow).Value
gWorksheet.Range("B4").Value = myWs.Range("Z" & dRow).Value
gWorksheet.Range("B5").Value = myWs.Range("X" & dRow).Value
Set shapeObject = Nothing
Set myChart = Nothing
Set gChartData = Nothing
Set gWorksheet = Nothing
gWorkbook.Close
Set gWorkbook = Nothing
The errors are completely random and occur during different iterations each time. I have found that the 1st time I run never produces the PPT stopped working error. Subsequent ones may.
Any ideas? I am baffled by what is happening here.
Note that I duplicate the template set into as many sets as I need before I iterate the Excel workbook. E.g, if the Excel worksheet has 10 rows, I duplicate the 4 template slides 10 times before doing any edits to the underyling data.
Is there a timing issue going on perhaps?
One thing which seems to be missing is the activation call before accessing the embedded worksheet:
gChartData.Activate
This might explain the crashing issues.
cf. https://msdn.microsoft.com/de-de/vba/powerpoint-vba/articles/chartdata-activate-method-powerpoint
Cheers
Jens
In management having and updating a deck of 150 slides is hard, when automation does not work. On Windows you can easily update numbers in Excel and Connected Graphs (Link to source data) change.
I don't know if anyone wondered, but it seems a long known issue:
To paint on the picture, to make clear what I want to achieve with my coding, here the rest of the story: In our company, there are coming all kind of systems together. I am using a Mac (and Office Mac), while others request the same data and working it with Office Windows. As I found out its the Apple system's arangement that disable many functions of MSO Programms or automation. I tested this automatic update story with a Office on Windows and Mac and did the following steps:
Created an Excel file and put in some numbers
Made a graph from that.
"Special-pasted" the graph in a new Powerpoint file (with link to data source - no here is not a mistake)
Changed numbers in Excel and it updated the graph in Powerpoint.
Saved and closed both files in one folder. (and did not change the path of course)
Opened the Excel again, changed data and opened Powerpoint (comparing Office Windows and Office Mac)
Office Windows: Powerpoint asked me to update all linked data. Data updated
Office Mac: did not ask anything. Data not updated.
So this is only the description of the bigger problem. To solve that issue (that may only be fixed in years... its been a long known issue already) I am trying to use VBA.
In the code I differenciate between Windows and Mac, finally there should be one code for all users. What I did so far:
run a code depending on the operating system (Mac is the problem!!)
copy range
create chart
paste range into chart
save chart as image
--> here I have problems, as saved files on Mac are empty (0 bytes).
NOTE: My example excel is hold easy and contains 3 sheets: UKI, France and Pictures. UKI and France are example sheets with numbers and graphs, created from those. The graphs' range is copied and used to copy - one by one - into pictures. The aim is to copy a chart, save it - and repeat this for each country area (eg. UKI France).
Where I am struggling is the export part. On Mac files normally are saved in a special microsoft folder ..../users/.../microsoft.com/data/......
When I try to adress "special folders"; such as desktop, pictures, documents (etc.) I receive an error message saying "permission denied". Here the Apple Sandbox Requirements seem to block me off.
Only the special folder "pictures" seem to work: saved files appear, but just like in the microsoft folder they are created empty.
I am new to VBA, so this i probably a mess of a code -
but why are the saved jpg/jpeg. files empty (also other picture-formats are empty)??
My Coding so far: (May be out of position a bit)
Sub TakePictures()
'check for running system; then play script for Mac or Windows
#If Mac Then
'I am a Mac
MsgBox "Call your Mac_Macro"
MsgBox "Call your Mac_Macro"
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'UKI
'copy the range as an image
Call Worksheets("UKI").Range("D1:I14").CopyPicture(xlScreen, xlPicture)
'remove all previous shapes in sheet2
intCount = Worksheets("Picture").Shapes.Count
For i = 1 To intCount
Worksheets("Picture").Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Worksheets("Picture").Shapes.AddChart
'activate sheet2
Worksheets("Picture").Activate
'select the shape in sheet2
Worksheets("Picture").Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Worksheets("Picture").Shapes.Item(1).Line.Visible = msoFalse
Worksheets("Picture").Shapes.Item(1).Width = Range("D1:I14").Width
Worksheets("Picture").Shapes.Item(1).Height = Range("D1:I14").Height
objChart.Paste
' Call AppleScript to get a special folder
Dim NameFolder As String
Dim SpecialFolder As String
' You can use : home, documents, desktop, music, pictures, movies, applications
NameFolder = "documents"
If Int(Val(Application.Version)) > 14 Then
SpecialFolder = _
MacScript("return POSIX path of (path to " & NameFolder & " folder) as string")
'Replace line needed for the special folders Home and documents
SpecialFolder = _
Replace(SpecialFolder, "/Library/Containers/com.microsoft.Excel/Data", "")
Else
SpecialFolder = MacScript("return (path to " & NameFolder & " folder) as string")
End If
Dim fileAccessGranted As Boolean
Dim filePermissionCandidates
'Create an array with file paths for which permissions are needed_
'filePermissionCandidates = Array("/Users/<user>/Desktop/test1.txt", "/Users/<user>/Desktop. /test2.txt")
'Request Access from User_
'fileAccessGranted = GrantAccessToMultipleFiles(filePermissionCandidates)
'save the chart as a JPEG
Dim LoginName As String
LoginName = UCase(GetUserID)
'ChDir "C:\Users\" & LoginName & "\Specialfolder"\"
Debug.Print LoginName
'objChart.Export ("C:Users\" & LoginName & "\documents\FY1718_UKI.jpg")
objChart.Export ("/Users/fabianvoss/pictures/FY1718_UKI.pdf")
'*here the export does give me empty files - tested out already all different kind of different data types.
#Else
'I am Windows
MsgBox "Call Windows_Macro"
'Activeselection.Export Filename:="D:\FY1718_UKI.jpg", Filtername:="JPG"
'Existiert Bild-Ordner unter Laufwerk C? -> Abfrage mit if:
'Wenn ja: Weiter
'Sonst: erstellen, dann weiter
On Error Resume Next
MkDir "C:\VBATestBilder"
On Error GoTo 0
'Neues Sheet erstellen: "Picture"
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
'UKI
'copy the range as an image
Call Worksheets("UKI").Range("D1:I14").CopyPicture(xlScreen, xlPicture)
'remove all previous shapes in sheet2
intCount = Worksheets("Picture").Shapes.Count
For i = 1 To intCount
Worksheets("Picture").Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Worksheets("Picture").Shapes.AddChart
'activate sheet2
Worksheets("Picture").Activate
'select the shape in sheet2
Worksheets("Picture").Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Worksheets("Picture").Shapes.Item(1).Line.Visible = msoFalse
Worksheets("Picture").Shapes.Item(1).Width = Range("D1:I14").Width
Worksheets("Picture").Shapes.Item(1).Height = Range("D1:I14").Height
objChart.Paste
'save the chart as a JPEG
objChart.Export ("C:\VBATestBilder\FY1718_UKI.Jpeg")
'FRANCE
'copy the range as an image
Call Worksheets("France").Range("D1:I14").CopyPicture(xlScreen, xlPicture)
'remove all previous shapes in sheet2
intCount = Worksheets("Picture").Shapes.Count
For i = 1 To intCount
Worksheets("Picture").Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Worksheets("Picture").Shapes.AddChart
'activate sheet2
Worksheets("Picture").Activate
'select the shape in sheet2
Worksheets("Picture").Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Worksheets("Picture").Shapes.Item(1).Line.Visible = msoFalse
Worksheets("Picture").Shapes.Item(1).Width = Range("D1:I14").Width
Worksheets("Picture").Shapes.Item(1).Height = Range("D1:I14").Height
objChart.Paste
'save the chart as a JPEG
objChart.Export ("C:\VBATestBilder\FY1718_France.Jpeg")
'Delete new chart
#End If
End Sub
I dont get why the files on Mac are created but empty... ?
(Then, if files can be saved, I need to import them to Powerpoint to very different positions on different slides (on Windows its easy, on Mac maybe difficult))
Thank you for reading,
I would appreciate any help
PS: I am completely new to VBA
regards,
Fabian
I have a requirement to extract a value from a word document on a daily basis and write it to an excel workbook. I currently do this manually and it is border line regarding the most efficient method for me
Using Excel file create a vba script and add any word document references.
2 Using the word navigate to the table “9. STOCKS...” (extracted example below – Appendix A) and read the Diesel (ltrs) daily usage highlighted in red.
3.Write this value to a spreadsheet cell.
The date for this value is also key but it held in another part of the word document (Appendix B). Dates are also in the file name but we trust the internal value more than the word document name. With knowledge from points 3 and 4 extract the associated date to an adjacent spreadsheet cell.
The table is displayed below, because of the formatting I'm not able to send you the exact table but I will be able to send the values of it.
9.STOCKS (As of 00:01 hrs on Day of report issue).
Stock Held
Daily Usage
Minimum Stock
Diesel (ltrs)
390436
15012
25000
Nitrogen (mm)
35
1
19
Champion 1033 (totes)
15
1
4
Nexguard (Boilers)
4
0.25
4 x 200 ltrs
Appendix B:
Beatrice Period of Report:
00:01 – 24:00 10th August 2010
If you have any doubts regarding my question please get back to me, I appreciate your efforts and wanted to thanks in advance
here's some code making use of late binding (declare objects rather than word.application etc). From Excel 2003, it
opens a WORD document
searches for string "minimum stock"
moves the cursor some lines/words further
expands/selects the WORD cursor
pastes this WORD selection into EXCEL
steps 2-5 are repeated for "Period of report:" (note that the ":" is a word boundary, so we need to jump 8 words to the right to arrive at the date)
For WORD I copied the text from your Q just as is (no table, just plain text). If you use tables instead, you may need to play with the units of the various Move statements (e.g. for cells unit:=12); the strategy remains the same: find a constant text, move cursor to final destination, expand selection, create a word range and transfer.
Both items are placed into the current cell in Excel and its right neighbor.
Sub GrabUsage()
Dim FName As String, FD As FileDialog
Dim WApp As Object, WDoc As Object, WDR As Object
Dim ExR As Range
Set ExR = Selection ' current location in Excel Sheet
'let's select the WORD doc
Set FD = Application.FileDialog(msoFileDialogOpen)
FD.Show
If FD.SelectedItems.Count <> 0 Then
FName = FD.SelectedItems(1)
Else
Exit Sub
End If
' open Word application and load doc
Set WApp = CreateObject("Word.Application")
' WApp.Visible = True
Set WDoc = WApp.Documents.Open(FName)
' go home and search
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "Minimum Stock"
' move cursor from find to final data item
WApp.Selection.MoveDown Unit:=5, Count:=1
WApp.Selection.MoveRight Unit:=2, Count:=2
' the miracle happens here
WApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1
' grab and put into excel
Set WDR = WApp.Selection
ExR(1, 1) = WDR ' place at Excel cursor
'repeat
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "Period of Report:"
WApp.Selection.MoveRight Unit:=2, Count:=8
WApp.Selection.MoveRight Unit:=2, Count:=3, Extend:=1
Set WDR = WApp.Selection
ExR(1, 2) = WDR ' place in cell right of Excel cursor
WDoc.Close
WApp.Quit
End Sub
You can create a button and call that sub from there, or link GrabUsage() to a function key.
I commented out the WApp.Visible = True because in production you don't want WORD even to show up, but you will need it for debugging and playing with the cursor movements.
The disadvantage of late binding (and not using references to the Word library) is the hardcoding of units (6=story, 5=line, 2=word) instead of using Word enumerations, but I sometimes get OS crashes with early binding .... not very sexy but it seems to work.
The FileDialog object needs a reference to the MS Office Office Library. AFAIK this is standard in Excel 2003, but better to check than to crash.
And I didn't include code to check if the items are really found; I leave this to your creativity.
Hope that helps.
I have an Access db to track metrics and "number crunch" data to build PowerPoint presentations. I do about 40 presentations per month, and they are 98% charts.
I run queries one at a time (using SQL statements), take the resulting data and copy it into an Excel template (I made a mock table in this "template" so the chart is already built and formatted), then copy the chart as a picture into a PowerPoint template.
So there is a lot of manual work.
How can I run multiple queries in Access with VBA on the same dataset/table (I have to do sales by quarter, by month, by region, by state, by site and all of these are Top5 aggregate, hence the reasons for the charts), and then send the resulting data to a specific Excel workbook, while defining what goes into what cell range?
If I get all the data into Excel, and have the charts ready to go, is there some VBA that will take the charts from Excel (activeworksheet) and paste them into PowerPoint as pictures in a quad view layout?
Can I do the same thing with an Access to PowerPoint approach and cut out Excel?
I am a novice at best.
You don't need to use Excel at all ! Use MS Access Charts in a report and some VBA code to put them into Powerpoint directly. There is already an example here
One "gotcha" is if you generate graphs in a group ie you design the report with a graph that is inside a group - so when you run the report you will get numerous graphs created.
It is a bit tricky to get hold of each of these graphs and drop them into Powerpoint but here is some code that will take care of it. This works in Access 2003
'Loop through all the controls in this report and pickout all the graphs
For Each c In pReport.Controls
'Graphs initially appear to be in an Object Frame
If TypeOf c Is ObjectFrame Then
'Check the Class of the object to make sure its a Chart
If Left$(c.Class, 13) = "MSGraph.Chart" Then
'Check if this graph must be cloned (required if the graph is in a group in the MS Access report)
If Not IsGraphToBeCloned(pReport.Name, c.ControlName) Then
InsertGraphToPptSlide c, "", pReport.Name
Else
InsertGraphGroupToPpt pReport.Name, c
End If
End If
End If
Next
This will find all the graphs in the report, if the graph is in a group then we call the InsertGraphGroupToPPt function.
The trick here is that we know we have the same base graph multiple times - but populated with different data. So in Powerpoint what you need to do is paste the base graph into powerpoint slides n times - where n is the number of groups and then update the graphs query properties
eg
Function UpdateGraphInPowerpoint(sql As String, OrigGraph As ObjectFrame, Groups As dao.Recordset, GroupName As String, ReportName As String) As Boolean
//Copyright Innova Associates Ltd, 2009
On Error GoTo ERR_CGFF
On Error GoTo ERR_CGFF
Dim oDataSheet As DataSheet
Dim Graph As Graph.Chart
Dim lRowCnt, lColCnt, lValue As Long, CGFF_FldCnt As Integer
Dim CGFF_Rs As dao.Recordset
Dim CGFF_field As dao.Field
Dim CGFF_PwrPntloaded As Boolean
Dim lheight, lwidth, LLeft, lTop As Single
Dim slidenum As Integer
Dim GraphSQL As String
Dim lGrpPos As Long
'Loop thru groups
Do While Not Groups.EOF
'We want content to be added to the end of the presentation - so find out how many slides we already have
slidenum = gPwrPntPres.Slides.Count
OrigGraph.Action = acOLECopy 'Copy to clipboard
slidenum = slidenum + 1 'Increment the Ppt slide number
gPwrPntPres.Slides.Add slidenum, ppLayoutTitleOnly 'Add a Ppt slide
'On Error Resume Next 'Ignore errors related to Graph caption
gPwrPntPres.Slides(slidenum).Shapes(1).TextFrame.TextRange.Text = ReportName & vbCrLf & "(" & Groups.Fields(0).Value & ")" 'Set slide title to match graph title
gPwrPntPres.Slides(slidenum).Shapes(1).TextFrame.TextRange.Font.Size = 16
gPwrPntPres.Slides(slidenum).Shapes.Paste 'Paste graph into ppt from clipboard
Set Graph = gPwrPntPres.Slides(slidenum).Shapes(2).OLEFormat.Object
Set oDataSheet = Graph.Application.DataSheet ' Set the reference to the datasheet collection.
oDataSheet.Cells.Clear ' Clear the datasheet.
GraphSQL = Replace(sql, "<%WHERE%>", " where " & GroupName & " = '" & Groups.Fields(0).Value & "'")
Set CGFF_Rs = ExecQuery(GraphSQL)
CGFF_FldCnt = 1
' Loop through the fields collection and get the field names.
For Each CGFF_field In CGFF_Rs.Fields
oDataSheet.Cells(1, CGFF_FldCnt).Value = CGFF_Rs.Fields(CGFF_FldCnt - 1).Name
CGFF_FldCnt = CGFF_FldCnt + 1
Next CGFF_field
lRowCnt = 2
' Loop through the recordset.
Do While Not CGFF_Rs.EOF
CGFF_FldCnt = 1
' Put the values for the fields in the datasheet.
For Each CGFF_field In CGFF_Rs.Fields
oDataSheet.Cells(lRowCnt, CGFF_FldCnt).Value = IIf(IsNull(CGFF_field.Value), "", CGFF_field.Value)
CGFF_FldCnt = CGFF_FldCnt + 1
Next CGFF_field
lRowCnt = lRowCnt + 1
CGFF_Rs.MoveNext
Loop
' Update the graph.
Graph.Application.Update
DoEvents
CGFF_Rs.Close
DoEvents
Groups.MoveNext
Loop
UpdateGraphInPowerpoint = True
Exit Function
End Function
Since you are a novice, perhaps you should break the task down into parts and automate the parts one at a time. Each step will provide benefits (i.e. time savings) and you can learn as you go.
It is hard to make specific recommendations based upon lack of specific information (what version etc.). That having been said, perhaps a good first step would be to link the Excel tables to the access queries so that the spreadsheets can auto-update every month and you will not have to cut and paste data from Access into Excel. You can do this linking entirely within Excel.
If you are using Excel 2007 click on "Data" in the Ribbon and then click on "From Access".
What you're asking is a lot of work:
Via VBA you'd have to open Excel (Excel Application manipulation from Access) , update your charts (Range manipulation, Data Update) if you have the rights then I would suggest having your pivot charts connected to the Access data and not pasted into the workbook, nevertheless I've been in enough situations where that was not possible. Then you would have to open your PowerPoint presentation and copy from the Excel to the PowerPoint. I've done all of these and know how much work it can save by creating a macro (via VBA) to do this. It's a lot of code.