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.
Related
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.
I'm developing a module to automatically import Excel worksheets into an Access table. The design of the worksheets being imported are identical. Using DoCmd.TransferSpreadsheets imports columns A-O (a mix of text and numeric data) well, however the values for columns P-AD have issues...
Column P and Q represent beginning and ending odometer values with R their elapsed distance. For example, on the worksheet Vehicle OHS-11 is reported as beginning at 154952, ending at 155636, for an elapsed distance of 684. The imported record shows as beginning AND ending at 155636, for an elapsed distance of 0.
Columns S-AA just refuse to import at all. Column AB imports 0 for all records including those with legitimate values (i.e., not null). Columns AC-AD sporadically import a 0, but many records are blank. See the figure below:
I've tried to no avail:
setting the field types in Access
letting Access create the table from scratch
DoCmd.RunSavedImport isn't ideal since the source spreadsheets have different names
a SELECT * INTO will create a new table for each worksheet and I am needing to consolidate the data from all spreadsheets to a single table
It is peculiar that the imports are successful without transfer error tables being created but yet the values are being ignored/swapped. Should it matter, the cells in columns E-P, R and AB-AD are formulas.
I am using Excel 2016 and Access 2016 on a Windows 10 tablet system. Here is the code:
Option Compare Database
Sub Import_New_WS()
'--- Import new worksheets to temporary table
Dim dbAC As Database
Dim rsList, rsMonth, rsXfer As Recordset
Dim strDestPath, strFilePath, strMFRSheetNo, strRange As String
Set dbAC = CurrentDb()
Set rsList = dbAC.OpenRecordset("SELECT * FROM [XFER_LIST_ONLY_LATEST_MFR]")
Set rsMonth = dbAC.OpenRecordset("SELECT * FROM [FP_MO_CAL_MO]")
'Set rsXfer = dbAC.OpenRecordset("SELECT * FROM [XFER_WS]")
If rsList.EOF = True Then Exit Sub 'Checks that there are worksheets to process
'--- Delete existing records from MFR consolidation table
'DoCmd.SetWarnings False
'DoCmd.RunSQL "DELETE * FROM [XFER_WS];"
'DoCmd.SetWarnings True
'--- Import worksheets into consolidation table
rsList.MoveFirst
strMFRSheetNo = Right(CStr(rsList.Fields("MFR_LAST_FP")), 2)
Do Until rsList.EOF
rsMonth.FindFirst "FISCAL_MO = " & strMFRSheetNo
strRange = rsMonth.Fields("WS_NAME") & "!A2:AD" & Format(rsList.Fields("NO_ROWS") + 1, "0")
strFilePath = rsList.Fields("FILE_PATH")
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "XFER_WS", strFilePath, False, strRange
strDestPath = "I:\Dept\DCS\MPOOL\Fleet Management Data\MFR\MFR FY " & Mid(CStr(rsList.Fields("MFR_LAST_FP")), 3, 2) & _
"\" & Mid(strFilePath, 81, Len(strFilePath))
Debug.Print strDestPath
'FileCopy strFilePath, strDestPath
'Kill strFilePath
rsList.MoveNext
Loop
Set dbAC = Nothing
Set rsList = Nothing
Set rsXfer = Nothing
Set rsMonth = Nothing
DeleteImportErrorTables
End Sub
After much research and testing multiple strategies to address this issue I simply went back to my original code and somehow it spontaneously started working correctly. The following day however, it was back to the original anomalous behavior!
Unable to find a solution to the issue I coded around the problem by saving the worksheet as a comma separated value (.csv) file and using DoCmd.TransferText instead. This strategy circumvented Access' data type guesswork and quickly imported the data into the table. (As an aside, DoCmd.TransferText doesn't like filenames with more than a single period in them.)
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 need help getting data into Microsoft Excel from an Allen-Bradley PLC automatically each time an "event" happens. For example, each time an alarm for a steam valve turns on, I need to record date, time, and duration of the problem. I can write the PLC code to gather the information. However, I am not sure how do get the information from the PLC to Microsoft Excel.
Any help is greatly appreciated!
The best and simplest way is to use AdvancedHMI & EPPlus.
They are very easy to use.
'***************************************
'* Open the existing Excel file
'***************************************
Using ExcelPackage As New OfficeOpenXml.ExcelPackage(New System.IO.FileInfo(".\HistoricalData.xlsx"))
'***************************************
'* Search for the first blank Excel row
'***************************************
Dim FirstBlankRow As Integer = 1
While ExcelPackage.Workbook.Worksheets(1).Cells(FirstBlankRow, 1).Value IsNot Nothing
FirstBlankRow += 1
End While
'**************************************
'* Show om the form the row to use
'**************************************
StatusLabel.Text = "Status: Blank Row found at " & FirstBlankRow
'***********************************************************************
'* Read the first tag within the UDT, then store in the Excel Worksheet
'***********************************************************************
Dim StartTime As String = EthernetIPforCLXCom1.Read("FillRecords[0].StartTime")
ExcelPackage.Workbook.Worksheets(1).Cells(FirstBlankRow, 1).Value = StartTime
'***********************************************************************
'* Read the second tag within the UDT, then store in the Excel Worksheet
'***********************************************************************
Dim EndTime As String = EthernetIPforCLXCom1.Read("FillRecords[0].EndTime")
ExcelPackage.Workbook.Worksheets(1).Cells(FirstBlankRow, 1).Value = EndTime
'**********************************
'* Save the Excel file changes
'**********************************
StatusLabel.Text = "Status: Saving Excel File on " & Now
ExcelPackage.Save()
There are many different ways to go about that. Rockwell sells software specifically for that use at a cost. It mostly depends on the scale of the data (amount/freq) and the number of PLCs that you are requesting the data from.
If it is just a smaller application you could use the licensed version of RSLinx Classic (about a grand) to setup a DDE link into Excel. That would be your most direct way in. Shawn over at AutomationBlog has a nice step by step.
https://theautomationblog.com/getting-allen-bradley-plc-and-pac-data-into-excel-using-rslinx/
If you have experience with VisualBasic you could use AdvancedHMI. It is free and can get the data out of your PLC, but then you will have to write the code to either fill your Excel worksheet or put the data into a SQL database.
http://www.advancedhmi.com/
Otherwise contact your local Rockwell rep and have them determine what might be the best fit.
I have an Excel file that contains data and charts. I've created a macro to read in a text file and update the data and the chart data ranges based on the date in the excel file. The data range will be starting 5 day prior to the date in the text file up to the date.
This works perfectly in Excel but now what I would like the macro to do is open a PowerPoint file I've already created that contains the two charts linked to the Excel file and change the data range of the Excel chart in the PowerPoint presentation.
I am able to open the PowerPoint and select the graph by name but I cannot change the data range.
Here is the code I am using currently that is not working but also not throwing any errors...
Open the PowerPoint and set the global oPPT variable to the open presentation.
Public Sub Open_PowerPoint_Presentation()
'Opens a PowerPoint Document from Excel
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set oPPTFile = objPPT.Presentations.Open(FileName:=ActiveWorkbook.Path & "\DailyHealthCheck.pptx")
End Sub
Call the routine above, change dates on some labels, and then attempt to change the source data of the Excel.
' open the gd metrics power point, must be manually closed later
Open_PowerPoint_Presentation
' set the dates in the ppt slide to the current date
oPPTFile.Slides(1).Shapes("Low Left Date").TextFrame.TextRange.Text = Format(Now, "MMMM d, yyyy")
oPPTFile.Slides(1).Shapes("Critical Issues Table").Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = "Grid Director Critical Issues (as of " & Format(Now, "M/d") & ")"
' change the date ranges of the chart
If ppdRangeStr <> "" Then
Dim splitDateRange() As String
splitDateRange = Split(ppdRangeStr, ":")
ppdRangeStr = "='process per day'!$" & Left(splitDateRange(0), 1) & "$" & Right(splitDateRange(0), Len(splitDateRange(0)) - 1) & ":$" & Left(splitDateRange(1), 1) & "$" & Right(splitDateRange(1), Len(splitDateRange(1)) - 1)
MsgBox ppdRangeStr
oPPTFile.Slides(1).Shapes("Processed Per Day Chart").Chart.SetSourceData Source:=ppdRangeStr, PlotBy:=xlColumns
' reset data labels
oPPTFile.Slides(1).Shapes("Processed Per Day Chart").LinkFormat.Update
End If
The String ppdRangeStr is "'processed per day'!$H77:$G81" which is the same range the chart in the Excel file (which works) is using.
Does anyone know how I can make the macro in the Excel file change the source data of the Excel chart in the PowerPoint where the source data is in the Excel file? (If that make sense?)