I have a number of files that are broken up by steps in a folder. For example:
1.xlsx
2.xlsx
3.xlsx
(etc. to about 9 files)
Each of these files contain cells or graphs to copy to a monthly PowerPoint presentation that's already formatted and ready, just needs the data and would like to avoid using links.
I'm stuck at pasting data into the open file.
Sub summary()
Dim pindex As Long
Dim wb As Excel.Workbook
Dim ppt As PowerPoint.Application
Dim pprsn As PowerPoint.Presentations
Dim ppslide As PowerPoint.Slide
'Whats the date of folder?
folder = InputBox("Please enter date")
directory = "" + folder
'Define the path for the summary PPTX
pptfile = directory + "\summary.pptx"
'Define the steps in Excel WB's
sn = directory + "\1.xlsx"
pu = directory + "\2a.xlsx"
pe = directory + "\2b.xlsx"
in = directory + "\3"
'****1*****
Set ppt = CreateObject("PowerPoint.Application")
ppt.Presentations.Open (pptfile)
Workbooks.Open (sn)
'Copy cells from sn
Worksheets("Snapshot").Range("A1:L29").Copy
'Paste into first slide in active pwerpoint presentation
???
End Sub
I tried different guides here and other websites. Most are creating a new PPT instead of editing one in the folder.
Any time I try to identify the indexID or use any other method it errors.
I'd like to work down the list copying each of the necessary cells & graphs into the PowerPoint presentation to help the team from having to rebuild their linked variables each month.
Any ideas?
I've figured it out. I should have been pasting directly with shapes vs. trying to select a slide index. Secondly, my dim statement for pprsn had an S which changed the arguments it could handle slightly.
Related
I've already read in the forums but noone has my exactly problem, so here we go.
I have my excel and powerpoint files in a OneDrive folder (the Powerpoint is in subfolder), the powerpoint has 100 links.
So, in a forum someone suggested that to get the local OneDrive path, you should turn off the process. I did it.
I have to have the excel file open, because the processing time is really slow if the excel is closed. So If I have opened the excel file and run the macro (in other folder diferent to OneDrive) it runs ok, but if I try to do the same but in the OneDrive folder, it generated the next error into the code line pptShape.LinkFormat.Update:
Error -2147188160 (80048240) in runtime. LinkFormat (unknown member):
Invalid request. The linked file was unavailable and could not be
updated
If I have the excel file closed, the macro runs ok, but the process is so slow (almost 30 minuts), because it open and close the excel a hundred times.
does anyone knows why it happened? How can I fix it? I'll appreaciate your help. here is the code to update the links
Sub updatelinks_1()
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
Application.DisplayAlerts = ppAlertsNone
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedOLEObject Then
Dim name, path1, path2, source, begin, search1, cells As String
Dim limit1 As Integer
name = pptShape.LinkFormat.SourceFullName
limit1 = InStr(1, name, "!")
cells = Right(name, Len(name) - limit1)
search1 = "subfoldername"
path1 = Application.ActivePresentation.FullName
begin = InStr(1, path1, search1)
begin = Left(path1, begin - 1)
file1 = Dir(begin & "*.xlsm")
source = begin & file1
End If
path2 = source & "!" & cells
pptShape.LinkFormat.SourceFullName = path2
'update method. code line where generate error
pptShape.LinkFormat.Update
End If
Next
Next
'Update the links (If I use this method on OneDrive folder, it doesn't work and broke all the links because replace the Link name with only the excel file name, not the sheets and cells)
' pptPresentation.UpdateLinks
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing
Application.DisplayAlerts = ppAlertsAll
End Sub
Good morning everyone.
As I have not seen the solution, I'd like to add my 2 cents.
I have had a similar issue, on a win10 Platform running Office 365.
In my case both files are on the same laptop.
I have seen that the powerpoint VBA procedure to update the path takes a long time by default. ( around 4 Minutes for me as there are 22 linked Objects).
One can speed it up by manually open the target excel file before launching the Powerpoint VBA.
It becomes effectively faster but I hit the issue where for each link the ppt vba procedure tries to update, we get a pop up window telling us that Excel can't open 2 files with same name.
I've tried to add in the PowerPoint VBA procedure : Application.DisplayAlerts = False , but is logically inefficient as applies to the PPT application and not to the Excel app !
I finally found one quick (and logic) solution :
at the beginning of the PowerPoint VBA, I ask user to locate the target excel file :
Set XlApp = CreateObject("Excel.Application")
ExcelFile = XlApp.GetOpenFilename(, , "Would you please locate your excel File")
And after, I just Open the target file, and set it with displayLAerts to False.
XlApp.Visible = True
Set xlWorkbook = XlApp.Workbooks.Open(ExcelFile, True, False)
Doing so, I no longer get warnings.
Full source code available .
Wish you a nice day !
I'm trying to create a macro that lists all the files in a given folder (and its sub folders) which match criteria for filename (in my example "job checklist") and type (in my example "*.xlsm"). since all the workbooks of this type and naming convention in my search folder are of the same type, i need to open and read values from each workbook and copy them into my host workbook. when the macro is run the run date/time should be noted in the host workbook, so that when the macro is run subsequently only new workbooks OR workbooks which have been modified since the most recent time stamp need to be opened and updated in the host workbook.
I have been trying to use some recursive code found in other posts, but threads, but i'm having a hard time to incorporate search criteria:
- file name
- file type
- modified date
[here] (VBA macro that search for file in multiple subfolders)
I have also tried to encorporate code from Pearson here to allow me to check file attributes of xls files but it doesnt seem to work (maybe due to 64 bit, though i found another version which was supposed to be compatible)
I've been trying to find a solution for several days, but am kinda stuck, any help would be appreciated.
working code i have so far which is listing all the files here of type .zip in my host workbook, i don't know how to check the modified date of a file. i assume that if i could i could add some code to open files (which meet type, name and modified (compared to a date/time value cell in the host workbook, and updates every time the macro is run) and then extract values from a known sheet/range into the host workbook.
```vba
Sub MainList()
Dim folder, xdir As Variant
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
Call ListFilesInFolder("C:\Users\60066690\Desktop\Documents from BCP and loose MTC", True)
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
If Not InStr(1, xFile.Name, ".zip") = 0 Then
'could need to add in here If for name, but not sure how to add If for modified date, if i could i could compare the modified date to a date cell in this workbook
Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name
'need to add some code in here to open the found workbook, then extract some values from known sheets/cells, store those values in variables, then close the found workbook and output the found variables to the colums beside the file name
rowIndex = rowIndex + 1
End If
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SubFolders
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
```
I have encountered a problem regarding the workbook.open function, when trying to open a workbook located on a network folder. The VBA macro leeds to an
"1004 Error"
without any specific reasons, only that the file path is not available.
I have used Google and this community for a very long time to solve this issue, below my steps I tried and my only solution at the end.
My question is: WHY does Excel behave like that and what can I do the next time?
Initially the user inputs the file path in a cell within the Source Workbook, saved locally on the computer. The VBA code take the input of the cell (I tried Range("K4") and also Range("K4").value) and aligns it to the string, which is visible (Variable Watch while Debugging) but failes when it comes to the Workbook.open function.
I tried to use the user specific network path (e.g. "G:/...") but also the Universal Network convention path ("\\xxx.xxx...") which is more accurate because not every user has mapped the network folder to the same drive letter.
At the end my only working solution was the hard coded path in the VBA editor with the UNC path.
Why is so? In this case the networkpath does not change, but when it comes to the moment where it is necessary that the folder must be written in a cell I will be lost.
Thank you for your feebdack!
EDIT:
Basically it's this code... I removed the unnecessary parts...
'Variablen
Dim MA$, Monat$, Fehltag$, Ort$, Projekt$, FilePlanung$, MainString$, NeuerString$
Dim LastRowM&, StartZelleP&, ProjektP&
Dim wb, wbP As Workbook
Dim wsK, wsS, wsM As Worksheet
Dim StartDatumM As Date
Dim array_monate As Variant
'Arbeitsblätter
Set wb = ThisWorkbook
Set wsK = wb.Sheets("Kopfblatt")
Set wsS = wb.Sheets("Stammdaten")
Set wsM = wb.ActiveSheet
'Fix
MA = wsK.Range("D2")
Monat = wsM.Name
FilePlanung = wsS.Range("K4")
Application.ScreenUpdating = False
Set wbP = Workbooks.Open(fileName:=FilePlanung)
'Set wbP = Workbooks.Open(FilePlanung) --> Tried also this and many other ways...
Set wsP = wbP.Sheets("aktuell")
This is the code I use:
Dim wb As Workbook
Set wb = Workbooks.Open(Worksheets("Sheet1").Range("A1").Value)
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 am trying to automate a daily process with Excel VBA to copy 6 worksheets from the Source File And create the copy in the Prod File and replace the old same name worksheets with the same name.This will become a “daily repetitive process” where I need to copy the 6 worksheets from the Source File to the Prod File. The worksheets are name the same in both files and want to keep the same worksheet names because I have formulas feeding the Prod File - Main Report.
I am not sure what would be the most Efficient and Effective method to either first Delete the prior worksheets from the Prod File and then copy the current worksheet to the Prod File.
Or
Copy the Source File worksheets to the Prod File, which will create a copy with the number 2, delete the prior worksheet and remove the 2 from the current worksheet name.
Like always I am grateful for this site where solutions are always found.
Here is the Process:
From Source File - I want to Copy the following Worksheets:
File Name, Sheet Name and Date convention:
Source FileName: CM Prism MTD ROR MMDDYYYY.xlsx
Worksheets:
Active Globally
Active USRR
Active Indices
MACO
Quantile
HY
To Prod File – Worksheets name will stay the same and Replace the prior worksheet.
File Name, Sheet Name and Date convention
Prod FileName: CM Composite MTD as of MM.DD.xlsm
Worksheets:
Active Globally
Active USRR
Active Indices
MACO
Quantile
HY
Also the Source File worksheets has the Valuation Date on Cell “D4” as “09-Oct—2015”, where I would like to add a “valuation date check” to make sure that the worksheets being copy from the Source file to the Prod file has the same Valuation Date as the Prod File on Cell “D6” as “10/09/2015”.
So if the valuation dates are the same copy to Prod file if not don’t copy it.
The goal is to add any ALERTS or Triggers that is not for Valuation Date.
This is what I have:
Sub copyNreplaceWorksheets()
Application.EnableEvents = False
Dim DpathSource As String
Dim DpathProd As String
Dim FolderName As String
Dim FileNameSource As String
Dim FileNameProd As String
Dim HolidayList
Dim RptDateSource As Date
Dim RptDateProd As Date
Dim wkbSource As Workbook
Dim wkbProd As Workbook
Dim shtToCopy As Worksheet
Set HolidayList = Range("I77:I86")
''****Set the Report File Date*****
'''Source File: CM Prism MTD ROR MMDDYYYY.xlsx
RptDateSource = Format(WorksheetFunction.WorkDay(Now(), -1, HolidayList), "mmddyyyy")
'''Prod File: CM Composite MTD as of MMDD.xlsm
RptDateProd = Format(WorksheetFunction.WorkDay(Now(), -1, HolidayList), "mm.dd")
'''****Set the File Name*****
'''Source File: CM Prism MTD ROR MMDDYYYY.xlsx
FileNameSource = "CM Prism MTD ROR" & RptDateSource & ".xlsx"
'''Prod File: Aladdin Composite MTD as of MMDD.xlsm
FileNameProd = "CM Composite MTD as of" & RptDateProd & ".xlsm"
'''****Set the Directory Path****
DpathSource = "U:\Performance\CM Performance\" & FileNameSource & ""
DpathProd = "U:\Performance\ROR calculations\2015\Daily Returns\" & FileNameProd & ""
Set wkbSource = Workbooks.Open("DpathSource")
Set wkbProd = Workbooks.Open("DpathProd")
Set shtToCopy = wkbSource.Sheets("Active US")
shtToCopy.copy wkbProd.Sheets("Active US")
Application.EnableEvents = True
End Sub
I think deleting the prior sheet, if it exists, will be more logical and easier to interpret in the future. Use a function like so:
Sub DeleteSheet(fromWorkbook as Workbook, sheetName as String)
'Deletes a named sheet from a workbook
' error would occur if the sheet doesn't exist (subscript out of range)
' which is ignored by Resume Next
On Error Resume Next
Application.DisplayAlerts = False
fromWorkbook.Sheets(sheetName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Then, in your code where you need to make the copy, do:
Set shtToCopy = wkbSource.Sheets("Active US")
Call DeleteSheet(wkbProd, "Active US")
shtToCopy.copy wkbProd.Sheets(wkbProd.Sheets.Count)
You'll want to remove the double quotes here:
Set wkbSource = Workbooks.Open(DpathSource)
Set wkbProd = Workbooks.Open(DpathProd)