How do I keep an instance unique? - excel

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

Related

VBA from Excel to PowerPoint (when both are open), problem with GetObject()

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!

Name or method not found during function call in excel

I'm just getting started with VBA. I have this Subprocess which erases a given Sheet for me without displaying an error message. However, the procecss is halted with an error in the eraseSheet call.. It says that name or method don't exist. I can't figure out where? wb is a workbook (as defined above). name_imported_sheet is defined as a string. Where is there a name or method that doesn't fit?
Sub eraseSheet(ByRef sheet As Worksheet)
Application.DisplayAlerts = False
sheet.Delete
Application.DisplayAlerts = True
End Sub
Sub mainSub()
Dim wb As Workbook: Set wb = ThisWorkbook
...
If sheetExists(name_imported_sheet) Then
eraseSheet (wb.Sheets(name_imported_sheet))
End If
...
End Sub
Also is there a way to get more precise interpreter warnings?

ExcelAnt add-ins in Workbook_Open won't run if the workbook was opened by another workbook's macro

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"

What is my error is setting this up? This Sub runs perfectly in a different workbook

A "Runtime Error 9, Subscript Out of Range" is received on the Set wb1 line. This similar structure runs fine in a different workbook without error.
My goal is to copy a cell from the Source document into te Destination document.
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim LastRow As Long
Set wb = Workbooks("C:\Test\DST.xlsm")
Set wb1 = Workbooks.Open("C:\Test\Source.xlsx")
wb1.Sheets("SourceNamedSheet").Range("A1") = wb.Sheets("DestinationNamedSheet").Range("A1").Value
wb1.Close
End Sub
If DST.xlsm is open already then
Set wb = Workbooks("DST.xlsm")
ElseIf you need to open DST.xlsm
Set wb1 = Workbooks.Open("C:\Test\DST.xlsm")
for a more robust approach to workbooks handling you may want to use the following GetOrSetWorkbook() function:
Option Explicit
Function GetOrSetWorkbook(wbName As String) As Workbook
On Error Resume Next
Set GetOrSetWorkbook = Workbooks(GetNameOnly(wbName)) '<--| check if a workbook with given name is already open
If GetOrSetWorkbook Is Nothing Then Set GetOrSetWorkbook = Workbooks.Open(wbName) '<--| if no workbook open with given name then try opening it with full given path
End Function
which uses the following helper GetNameOnly() function:
Function GetNameOnly(pathStrng As String) As String
Dim iSlash As Long
iSlash = InStrRev(pathStrng, "\")
If iSlash > 0 Then
GetNameOnly = Mid(pathStrng, iSlash + 1, Len(pathStrng))
Else
GetNameOnly = pathStrng
End If
End Function
so that a possible use of it could be:
Option Explicit
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim LastRow As Long
Set wb = GetOrSetWorkbook("C:\Test\DST.xlsm") '<--| try getting "C:\Test\DST.xlsm"
If wb Is Nothing Then '<--| if unsuccessful...
'... code to handle C:\Test\DST.xlsm workbook error, like:
MsgBox "Couldn't find 'C:\Test\DST.xlsm' !", vbCritical + vbOKOnly
End If
Set wb1 = GetOrSetWorkbook("C:\Test\Source.xlsx") '<--| try getting "C:\Test\Source.xlsx
If wb Is Nothing Then '<--| if unsuccessful...
'... code to handle 'C:\Test\Source.xlsx' workbook error, like:
MsgBox "Couldn't find 'C:\Test\Source.xlsx'!", vbCritical + vbOKOnly
End If
'here goes rest of the code to be executed once all necessary workbooks have been properly set
wb1.Sheets("SourceNamedSheet").Range("A1") = wb.Sheets("DestinationNamedSheet").Range("A1").Value
wb1.Close
End Sub
of course a very similar GetOrSet approach can be assumed with worksheets, too...

excel 2007 Workbook_open not working

I am trying to clear Print Area And Autofilter when excel opens:
Am total novice in Excel vba so Assmebled the followingcode from googling around
This code I have put in ThisWorkbook of Personal.xlsb in the XLstart folder and ofcourse the macro security has been set to enable all macros
Option Explicit
Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub Workbook_Close()
Set xlApp = Nothing
End Sub
Private Sub xlApp_WorkbookOpen(ByVal Wb As Workbook)
Application.EnableEvents = False
Call ClrPrntArea
Application.EnableEvents = True
End Sub
Here is the ClrPrntArea
Sub ClrPrntArea()
Dim ws As Object
For i = 1 To ActiveWorkbook.Worksheets.count
With Worksheets(i)
.PageSetup.PrintArea = ""
.PageSetup.FitToPagesWide = 1
End With
Next
End Sub
I will also be putting another macro call to module in personal xlsb for resetting the autofiter once above starts working..Any inputs will be really helpfull
in PERSONAL.xlsb, module ThisWorkbook, try the below; it's nearly the same code as in your request, with some modif's:
application object declared Private
event routine uses the local WB object variable handed over as parameter, instead of the ActiveWorkbook object
replaced For ... Next by For Each ... Next and working with local object variables
trap processing of PERSONAL.xlsb itself
Once you're happy remove all the MsgBox statements (and the Else), they are just to show what is happening and when.
Private WithEvents Excel_App As Excel.Application
' runs when Excel_App encounters a Workbook_Open() event
Private Sub Excel_App_WorkbookOpen(ByVal WB As Workbook)
Dim WS As Worksheet
If WB.Name <> "PERSONAL.xlsb" Then
MsgBox "PERSONAL.xlsb: Excel_App_WorkbookOpen(): " & WB.Name
For Each WS In WB.Worksheets
WS.PageSetup.PrintArea = ""
WS.PageSetup.FitToPagesWide = 1
If WS.FilterMode Then
WS.ShowAllData
End If
Next
Else
MsgBox "PERSONAL.xlsb: Excel_App_WorkbookOpen(): myself"
End If
End Sub
' runs when PERSONAL.xlsb is opened
' assign current Excel application to object variable Excel_App
Private Sub Workbook_Open()
MsgBox "PERSONAL.xlsb: Workbook_Open()"
Set Excel_App = Application
End Sub
Note:
When the event handler doesn't start when you double-click an Excel file (e.g. on your desktop), close all Excel applications and inspect the task manager for additional orphaned Excel processes which need to be killed. It happened to me while playing around with this code

Resources