I need to automate moving stuff from excel into PowerPoint. I build put together a macro, which works fine and it is basically running in PowerPoint, accessing Excel, taking some range of nicely formatted tables, and pasting as enhanced metafile:
Function CopyFromExcelToPPT(excelFilePath As String, sheetName As String, rngCopy As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long, Optional shapeHeight As Long, Optional shapeWidth As Long)
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
Set eApp = New Excel.Application
eApp.Visible = False
Set wb = eApp.Workbooks.Open(excelFilePath)
Set ppt = ActivePresentation
'Copy cells in Excel
wb.Sheets(sheetName).Range(rngCopy).Copy
'Paste into first slide in active PowerPoint presentation
ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteEnhancedMetafile
'Close and clean-up Excel
eApp.CutCopyMode = False
wb.Close SaveChanges:=False
eApp.Quit
Set wb = Nothing: Set eApp = Nothing
'Move the new shape if left/top provided
If Not (IsMissing(shapeTop)) Then
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
.Left = shapeLeft
.Top = shapeTop
End With
End If
'Resize the shape if height/width provided
If Not (IsMissing(shapeHeight)) Then
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
.Height = shapeHeight
.Width = shapeWidth
End With
End If
'Put them to the back
With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
While .ZOrderPosition > 2
.ZOrder msoSendBackward
Wend
End With
CopyFromExcelToPPT = True
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.CutCopyMode = False
eApp.Quit
End If
CopyFromExcelToPPT = False
End Function
The problem is, that I need to run this like 80x, and after each 5 loads I need to run a macro in that source excel, which will update data. Therefor I tried to either keep excel open during this macro, and manually lunch that macro, or ideally incorporate all of this into this PowerPoint macro.
I tried different approaches, however, I am not able to make it work, I am getting always errors.
Firstly I tried to to create another function handling running macro, and eventually chain it together with main function in main sub:
Function CallTopsheetMacro(excelFilePath As String, sheetName As String)
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application, wb As Excel.Workbook
Set eApp = New Excel.Application
eApp.Visible = True
Set wb = eApp.Workbooks.Open(excelFilePath)
wb.Run "'...\excel.xlsb'!macro_01"
wb.Wait (Now + TimeValue("0:00:10"))
'Close and saves Excel
wb.Close SaveChanges:=True
wb.Wait (Now + TimeValue("0:00:10"))
eApp.Quit
Set wb = Nothing: Set eApp = Nothing
MsgBox ("Done!")
CallTopsheetMacro = True
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.CutCopyMode = False
eApp.Quit
End If
CallTopsheetMacro = False
End Function
But this functions did basically nothing, only opens and closes excel, waiting is not even reflecting. Then I tried with both sessions (main PowerPoint taking the pictures, and excel which is providing pictures and running macros) running, as I would avoid manually triggering macros and wasting time with open/close excels which is pretty bulky:
Function CallTopsheetMacroActive()
On Error GoTo ErrorHandl 'Handle Errors
'Set Variables and Open Excel
Dim eApp As Excel.Application
Set eApp = GetObject("..\excel.xlsb", "Excel.Application")
eApp.Visible = True
'Run macro
eApp.Run "'...\excel.xlsb'!macro_01"
MsgBox ("Done!")
Exit Function
ErrorHandl:
'Make sure to close the workbook and Excel and return False
On Error Resume Next
If Not (eApp Is Nothing) Then
wb.Close SaveChanges:=False
eApp.CutCopyMode = False
eApp.Quit
End If
End Function
This one is doing nothing. Then I tried to examine the syntax for GetObject, even with small testing scripts, but it is not working. I have even added references for scrrun.dll, as I have 64bit and it was suggested in couple of similar topics, but of no help. For a simple code like this:
Sub GetObject_Testing()
Dim MyExcel As Excel.Workbook
Dim MySheet As Worksheet
Dim MyFilePath As String
'Set MyExcel = GetObject("Excel.Application")
MyFilePath = "...\excel.xlsb"
Set MyExcel = GetObject(MyFilePath, "Excel.Application")
For Each MySheet In MyExcel.Sheets
Debug.Print MySheet.Name
Next MySheet
End Sub
I am getting run.time error 432 (file name or class name not found during automation operation).
I have no idea what I may be doing wrong, and just to make sure I am providing whole code, just in case I have some error somewhere.
Would appreciate any suggestions which will help to solve this.
PS: Doing this from PowerPoint, because when I tried to the same from Excel, I was getting error that there is not enough memory to start PowerPoint.
Thanks!
Related
Currently making a quick macro that opens a bunch of other workbooks in new instances:
Sub open_files()
Dim Path As String
Dim Fname As String
Dim xlApp As Object
MyFiles = Dir("C:\my_folder\*xls*")
Do While MyFiles <> ""
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Open ("C:\my_folder\" & MyFiles)
MyFiles = Dir
Loop
End Sub
This works fine on sheets that don't have any ExcelAnt functions in Workbook_Open, but for those that do, I get a popup that says: "Run-time error '1004': cannot run the macro 'Connect'. The macro may not be available in this workbook or all macros may be disabled. "
I've tried forcing in the add-in before running the "connect" part of the code but to no avail.
Public Sub Workbook_Open()
Dim TestWkbk As Workbook
Set TestWkbk = Nothing
On Error Resume Next
Set TestWkbk = Workbooks("ExcelAnt-AddIn64.xll")
On Error GoTo 0
If TestWkbk Is Nothing Then
Set TestWkbk = Workbooks.Open("C:\ExcelAnt\ExcelAnt-AddIn64.xll")
End If
Dim hostenv As String
hostenv = Left(Environ("computername"), 3)
Application.Run "Connect", "prd"
End Sub
To clarify, the sheet if opened manually works fine.
Any help would be appreciated. Thanks in advance.
Use RegisterXLL with the new instance of Excel (xlApp).
xlApp.RegisterXLL "C:\ExcelAnt\ExcelAnt-AddIn64.xll"
I posted a question recently on interacting with another WB in a separate instance of Excel.
How to add Open Workbook to "Application.Workbooks" collection and/or interact with Workbook
But I had hardcoded the copy/paste range for testing, and now I'm having trouble with coping the entire worksheet to the "main wb". Eg: xlApp.Worksheets(1).Copy After:=Application.ActiveWorkbook.Sheets(1)
I get the error Copy Method of Worksheet Failed and ideas how to adjust this to work?
Public Sub Copy_External_WB()
Dim xlApp As Excel.Application, xlBook As Worksheet, i As Long
For i = 1 To 10
On Error Resume Next
Set xlApp = GetObject("Book" & i).Application
If Err.Number = -2147221020 Then
Err.Clear: On Error GoTo 0
Else
On Error GoTo 0
Exit For
End If
Next i
If Not xlApp Is Nothing Then
Set xlBook = xlApp.Worksheets(1)
Debug.Print xlApp.hWnd, Application.hWnd
Else
MsgBox "No Excel session with Book(1 - 10) open could be found..."
xlApp.Quit: Exit Sub
End If
'Dim CopyFrom As Range
'Set CopyFrom = xlBook.Range("A1:AQ56")
'Dim DS As Worksheet
'Set DS = ThisWorkbook.Worksheets("Merged")
'DS.Range("A1:AQ56").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value
xlApp.Worksheets(1).Copy After:=Application.ActiveWorkbook.Sheets(1)
xlApp.DisplayAlerts = False
xlApp.Quit
xlApp.DisplayAlerts = True
Set xlApp = Nothing
End Sub
You cannot copy a whole sheet object between different Excel instances.
Options:
Use VBA to save the other workbook to file, then open it in the instance where your code is running, and copy the sheet to your workbook
Copy (eg) the UsedRange from the other instance's worksheet, then paste in your primary instance workbook
I'm looking to create a spell check macro for protected word documents. I'm more familiar with Excel VBA and I just created a similar project for protected spreadsheets so I attempted to follow the same logic. So far my code copies misspelled words from the office document, into a new excel workbook and then runs spellcheck, but I am having trouble pasting the new value back into the original word document. I can't have this require "adding a reference library" as this will need to be portable and run without end user intervention.
Here is what I have so far:
Sub SpellCheckDoc()
Dim lockedFields As Long
Dim unlockedFields As New Collection
For Each theFields In ActiveDocument.Fields
If theFields.Locked = True Then
lockedFields = lockedFields + 1
Else
unlockedFields.Add theFields
End If
Next theFields
If lockedFields = ActiveDocument.Fields.Count Then Exit Sub
'Word
Dim objWord As Object 'Word.Application
Set objWord = GetObject(, "Word.Application")
'Excel
Dim objExcel As Object, objWB As Object
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
objExcel.Visible = True
Set wb = objExcel.ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
For Each theFields In unlockedFields
If CheckSpelling(theFields.Result.Text) = False Then
theFields.Copy ' Select text from Word Doc
'Paste into new workbook and spellcheck
With ws
.Range("A1").Select
.Paste
.Range("A1").CheckSpelling
.Range("A1").Copy
End With
objWord.theFields.Paste ''' This line doesn't work
End If
Next theFields
End Sub
Change theFields.Result.Text. So you can do .CheckSpelling in Excel, then make theFields.Result.Text = .Range("A1").Text
Dim correctSpelling as String
With ws
.Range("A1").Select
.Paste
.Range("A1").CheckSpelling
correctSpelling = .Range("A1").Text
End With
theFields.Result.Text = correctSpelling
End If
Next theFields
End Sub
My code below scans the provided doc file (sp parameter) and copy over the tables to a sheet named "xxxx" (given in global variable 'shtTableName'.
This code is working perfectly fine when computer is NOT locked. But this code fails to run when screen/computer is locked.
I traced that the issue.. it is with line
sht.Paste Range("A1")
i tried
Acitvesheet.Paste
but it throws same error.
I tried every possible thing in Excel vba but none worked,....
on top of this, when it throws error, it is not captured in ErrWord section, it immediately throws the error to the parent error handler of calling procedure....
I cant understand why screen/computer locking can create such an issue.
Any help would be greatly appreciated.
I am using Windows 10 Version 1808 Build 10730.20348
Thanks
Gaurav
Sub read_word_document(filename As String)
Dim DOC_PATH As String
DOC_PATH = filename
Dim sht As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim i As Long, r As Long, c As Long
Dim rng As Range, t As Word.Table
Dim oData As New DataObject 'object to use the clipboard
Dim bWordDocObjectCreated As Boolean
On Error GoTo ErrWord
bWordDocObjectCreated = False
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(DOC_PATH, ReadOnly:=True)
bWordDocObjectCreated = True 'indicates that object WordDoc has been created and file has been opened
Set sht = Sheets(shtTableName)
Set rng = sht.Range("A1")
For Each t In WordDoc.Tables
sht.Cells.Delete Shift:=-4162
sht.Activate
sht.Range("A1").Select
t.Range.Copy
sht.Paste Range("A1")
'ActiveSheet.Paste
Exit For 'get only first table
Next t
Application.CutCopyMode = False
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take it to the clipboard to empty it
Application.DisplayAlerts = False
WordDoc.Close False
WordApp.Quit
Exit Sub
ErrWord:
If Not UCase(Err.Description) Like "*CORRUPTED*" And bWordDocObjectCreated = True Then
Data.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take in the clipboard to empty it
Application.CutCopyMode = False
Application.DisplayAlerts = False
WordDoc.Close False
End If
WordApp.Quit
End Sub
I had a similar problem but in excel. The solution that worked for me was adding
Application.ScreenUpdating = False at the beginning of the macro. This may or may not work in your case.
Generally speaking, macros that simulate a user's actions e.g copy/pasting, sending keystrokes, cannot be run when the screen is locked - in my experience.
You may need another application to ensure the screen is unlocked before running the macro, or keep the screen unlocked. I have used Caffeine for this purpose successfully.
In my work, I've made an workbook for my entire team to use, saved a macro in personal.xlsb to open it from anywhere in another instance of excel.
Its working fine by now, but I found a problem that i couldnt solve:
When the workbook is the last workbook open(when the first instance of excel is closed and left only the instance of my workbook), the next ones I open, start in the SAME instance of the workbook. (originally in instance 2) forcing me to run the code again to separate it.
Is there any way to protect that instance specially to the workbook itself?
sorry for my bad english.
Thanks
My code is:
Sub quickwb()
Dim NewExcel As Object
Set NewExcel = New Excel.Application
With NewExcel
.DisplayAlerts = False
.Visible = True
.Workbooks.Open "workbooknameandpath"
.DisplayAlerts = True
End With
End Sub
I'm not exactly sure what your issue is but below is a function I use to open a workbook if it's not already open.
Sub QuickWB()
On Error Resume Next
Dim wb As Workbook: Set wb = GetWorkBook("pathandbook")
If Not wb Is Nothing Then
' Do something
End If
End Sub
Public Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
Dim sFile As String: sFile = Dir(sFullName)
On Error Resume Next
Set GetWorkBook = Workbooks(sFile)
If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
On Error GoTo 0
End Function