I am trying to suppress the message which pops up on deletion of sheet in the embedded excel of a PPT chart, using this code snippet:
POP-UP MESSAGE
CODE-SNIPPET:
Sub MainSub()
' Some code here
' reference to excel has been added
If SelShape.HasChart = True Then
Dim SelChart As PowerPoint.Chart
Set SelChart = SelShape.Chart
Dim Selchtdat As PowerPoint.ChartData
Set Selchtdat = SelChart.ChartData
On Error Resume Next
Selchtdat.Activate
On Error GoTo 0
Dim EmbdExcel As Excel.Workbook
Set EmbdExcel = Selchtdat.Workbook
Call FilterRequiredData (EmbdExcel, "Data")
End If
' Some code here
End Sub
'-----------------------------------------------------------------------------------------------------
Private Sub FilterRequiredData(ChrtWbk As Excel.Workbook, stname As String)
ChrtWbk .Activate
On Error Resume Next
Excel.Application.DisplayAlerts = False
ChrtWbk.Sheets("TempSheet").Delete
Excel.Application.DisplayAlerts = True
On Error GoTo 0
ChrtWbk.Sheets.Add(After:=ChrtWbk.Sheets(ChrtWbk.Sheets.count)).Name = "TempSheet"
'Some other code
End Sub
This code works perfectly in the native Excel VBA environment, but when invoked in PPT VBA Environment, it doesn't suppress the message. Can anybody tell me why this doesn't work ? Are there any other ways to tackle this ?
Related
I am attempting to import a userform, and show it on initial startup. The userform imports just fine, however, when attempting to show it, I keep getting a Run-time error '424' Object Required.
Here is my code:
Sub Workbook_Open()
Dim wkbTarget As Excel.Workbook
Dim szTargetWorkbook As String
Dim cmpComponents As VBIDE.VBComponents
Application.ScreenUpdating = False
szTargetWorkbook = ActiveWorkbook.Name
Set wkbTarget = Application.Workbooks(szTargetWorkbook)
Set cmpComponents = wkbTarget.VBProject.VBComponents
' IMPORT FORM
cmpComponents.Import "\\myserver.domain\Application\Forms\LOGIN.frm"
LOGIN.Show
End Sub
When I click End on the error, I can then show the userform just fine.
The run-time (thanks #Comintern!) won't like you referring to an object that doesn't exist yet. You could use:
Userforms.add("LOGIN").Show
to avoid that direct reference.
I have two workbooks in the same folder: bkOpenErrorTest.xlsm and bkOpenErrorTest_dict.xlsm.
bkOpenErrorTest_dict.xlsm has the following code in its ThisWorkbook module:
Private Sub workbook_open()
Dim dict As Dictionary
Set dict = New Dictionary
dict.Add 0, 0
dict.Add 0, 0
End Sub
When this workbook is opened by double-clicking the filename, it throws the expected unhandled error:
This key is already associated with an element of this collection
bkOpenErrorTest.xlsm has the following code in Module1:
Sub testOpen()
Dim bk As Workbook
On Error GoTo errHandler
Workbooks.Open ThisWorkbook.Path & "\bkOpenErrorTest_dict.xlsm"
Exit Sub
errHandler:
Debug.Print "reached error handler"
End Sub
When error trapping is set to Break on Unhandled Errors, and I run testOpen(), the unhandled error is still raised when bkOpenErrorTest_dict.xlsm opens. Why isn't the error caught by testOpen()'s error handler? And how can I handle this error? I have an application where I'd like to cycle through many workbooks in a folder that have buggy code like this in their workbook_open() event, and I can't iterate through them if the program crashes on an unhandled error like this.
The reason that the error is not being handled is that the two processes are not in the same thread. If you were calling a 'helper' sub procedure from a main sub procedure, you remain in the same thread and errors thrown in the 'helper' are caught by error control in the main. This is akin to why an error in a procedure launched by Application.Run will not have thrown errors handled by the error control in the procedure that launched it.
To gain any measure of control over what happens in the newly opened workbook's Workbook_Open, you need to control things on the Application instance level. The following halts execution of the Workbook_Open event procedure; if it isn't necessary to process the code, then this could be your solution.
Application.EnableEvents = False
Set bk = Workbooks.Open(ThisWorkbook.Path & "\bkOpenErrorTest_dict.xlsb")
Application.EnableEvents = True
If the Dictionary populating is the specific error you are trying to overcome use the dictionary shorthand method that overwrites duplicates.
Dim dict As Dictionary
Set dict = New Dictionary
dict.Item(0) = 0
dict.Item(0) = 1
'dict.count = 1 with key as 0 and item as 1
More generally you can wrap potential errors in On Error Resume Next and On Error GoTo 0.
Dim dict As Dictionary
Set dict = New Dictionary
On Error Resume Next
dict.Add 0, 0
dict.Add 0, 1
On Error GoTo 0
'dict.count = 1 with key as 0 and item as 0
The error is unhandled because the newly opened Workbook is running inside of what is basically an asychronous process - Workbook_Open is an event handler, so it is not being called from your code. It is being invoked as a callback function from inside whatever external Excel process is opening the document. You can demonstrate the same behavior with any event handler:
'In Sheet1
Sub Example()
On Error GoTo Handler
Sheet1.Cells(1, 1).Value = "Foo"
Exit Sub
Handler:
Debug.Print "Handled"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 And Target.Column = 1 Then
Err.Raise 6
End If
End Sub
If you need to bulk process the files, your only (easy) option is going to be disabling events before the call to open:
Sub testOpen()
Dim bk As Workbook
On Error GoTo errHandler
Application.EnableEvents = False
Set bk = Workbooks.Open ThisWorkbook.Path & "\bkOpenErrorTest_dict.xlsm"
Application.EnableEvents = True
Exit Sub
errHandler:
Debug.Print "reached error handler"
End Sub
If for some reason it is vitally important that the buggy Workbook_Open runs, then you can use the solution Tim Williams outlines here. Just create a public wrapper function in the target workbook, then call that from within the context of your own error handler.
I having autocad project where is 1 dynamic block which I'm trying to change from excel.
Here is vba script which I'm using to change block:
Dim dybprop As Variant, i As Integer
Dim bobj As AcadEntity
For Each bobj In ACADApp.ModelSpace
If bobj.ObjectName = "AcDbBlockReference" Then
If bobj.IsDynamicBlock Then
If bobj.EffectiveName = "AdjBlock" Then
dybprop = bobj.GetDynamicBlockProperties
For i = LBound(dybprop) To UBound(dybprop)
If dybprop(i).PropertyName = "Distance1" Then
dybprop(i).Value = 50.75
Acad.Application.Update
End If
Next i
End If
End If
End If
Next
End With
When I'm running it in AutoCAD VBA it works excellent. Than I'm creating Excel VBA project and copying this code. Before running it I creating connection to existing AutoCad project like this:
On Error Resume Next
Dim ACADApp As AcadApplication
Dim a As Object
Set a = GetObject(, "AutoCAD.Application")
If a Is Nothing Then
Set a = CreateObject("AutoCAD.Application")
If a Is Nothing Then
MsgBox "AutoCAD must be running before performing this action.", vbCritical
Exit Sub
End If
End If
Set ACADApp = a
Set ACADApp.ActiveDocument = ACADApp.Documents.Open("c:\KIRILL\Programming\Drawing1_VBATest.dwg")
When I'm running it from Excel VBA - AutoCAD project appears but nothing change. Honestly I don't have any idea why in Excel VBA it doesn't works while in AutoCAD it work. May be somebody had this problem before? Thanks in advance.
P.S. Full Excel VBA code:
Sub Button9_Click()
On Error Resume Next
Dim ACADApp As AcadApplication
Dim a As Object
Set a = GetObject(, "AutoCAD.Application")
If a Is Nothing Then
Set a = CreateObject("AutoCAD.Application")
If a Is Nothing Then
MsgBox "AutoCAD must be running before performing this action.", vbCritical
Exit Sub
End If
End If
Set ACADApp = a
Set ACADApp.ActiveDocument = ACADApp.Documents.Open("c:\KIRILL\Programming\Drawing1_VBATest.dwg")
Dim dybprop As Variant, i As Integer
Dim bobj As AcadEntity
For Each bobj In ACADApp.ModelSpace
If bobj.ObjectName = "AcDbBlockReference" Then
If bobj.IsDynamicBlock Then
If bobj.EffectiveName = "AdjBlock" Then
dybprop = bobj.GetDynamicBlockProperties
For i = LBound(dybprop) To UBound(dybprop)
If dybprop(i).PropertyName = "Distance1" Then
dybprop(i).Value = 50.75
Acad.Application.Update
End If
Next i
End If
End If
End If
Next
End Sub
Have you tried adding the reference library?
You can go to:
Tools->References
And add:
[AutoCAD 20xx Type Library]
I have password-protected .xls files in a directory. I would like to open each of these files and save them without the password.
However, the files can be opened by using either of the sample passwords listed below.
pwd1 = "123"
pwd2 = "456"
pwd3 = "789"
'Check if pwd1 opens
Application.Workbooks.Open(Filename:=fn, Password:=pwd1)
'If fail then use pwd2
Application.Workbooks.Open(Filename:=fn, Password:=pwd2)
'and so on..
How should I implement this?
Once the file has been opened once, you only need to Unprotect it. This will save a lot of time, instead of constantly opening/closing workbooks.
Here's how I'd do it:
Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"
Dim wb As Workbook
Set wb = Workbooks.Open(fn)
Dim lst As Variant
lst = Array("123", "456", "789")
Dim item As Variant
For Each item In lst
On Error GoTo did_not_work
Call wb.Unprotect(item)
Call wb.Save
Call wb.Close(False)
Exit Sub
did_not_work:
On Error GoTo 0
Next item
End Sub
In other words, create an array of strings and do a For Each on them, and set some error-handling to deal with all the failed attempts.
I know GoTo statements are a bit yucky, but that's the best way to handle errors in VBA (as far as I know).
I tried #lebelinoz answer however the routine gives a 1004 error. I googled this behavior and found this post:
https://stackoverflow.com/questions/21176638/vba-how-to-force-ignore-continue-past-1004-error
The code below works by using On Error Resume Next. I based this on #lebelinoz answer.
Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"
Dim wb As Workbook
Dim item As Variant
Dim lst As Variant
lst = Array("123", "456", "789")
For Each item In lst
On Error Resume Next
Workbooks.Open Filename:=fn, Password:=item
If Err.Number <> 0 Then GoTo did_not_work:
Exit For
did_not_work:
Next item
Set wb = Activeworkbook
wb.SaveAs Filename:=fn, Password:=""
wb.Close
End Sub
When dynamically loading an Excel 2010 Add-In, one must also alter the VBA references to include the newly added Add-In, after it has been loaded into the workbook.
This code works for programmatically loading the add-in:
Function LoadAddin(strFilePath As String) As Boolean
' Checks whether add-in is in collection, and
' then loads it. To call this procedure, pass
' in add-in's path and file name.
Dim addXL As Excel.AddIn
Dim strAddInName As String
On Error Resume Next
' Call ParsePath function to return file name only.
'strAddInName = ParsePath(strFilePath, FILE_ONLY) 'not available in VBA...so it seems to always physically load it below, which seems to work fine.
' Remove extension from file name to get add-in name.
strAddInName = Left(strAddInName, Len(strAddInName) - 4)
' Attempt to return reference to add-in.
Set addXL = Excel.AddIns(strAddInName)
If err <> 0 Then
err.Clear
' If add-in is not in collection, add it.
Set addXL = Excel.AddIns.Add(strFilePath)
If err <> 0 Then
' If error occurs, exit procedure.
LoadAddin = False
GoTo exit_function
End If
End If
' Load add-in.
If Not addXL.Installed Then addXL.Installed = True
LoadAddin = True
exit_function:
Exit Function
End Function
So is there a way to now add this to the References so VBA code in the host spreadsheet that refers to VBA within this newly included Add-In will execute properly?
It appears that the route to go might be something like:
ThisWorkbook.VBProject.References.AddFromFile ("C:\MyFiles\MyAddin.xlam")
...but this gives me the error:
Microsoft Visual Basic for Applications
Run-time error '32813':
Application-defined or object-defined error
Have you considered using the same code (but slightly modified) in the Workbook open event of the Add-In?
If I understand you correctly then I guess this is what you want?
Public ShouldIContinue As Boolean
Private Sub Workbook_Open()
'~~> This is required to avoid the endless loop
If ShouldIContinue = True Then Exit Sub
Dim addXL As AddIn
Dim strAddInName As String
Dim oTempBk As Workbook
strFilePath = ThisWorkbook.FullName
strAddInName = ThisWorkbook.Name
'~~> This will work for both .xla and .xlam
strAddInName = Left(strAddInName, (InStrRev(strAddInName, ".", -1, _
vbTextCompare) - 1))
On Error Resume Next
Set addXL = Excel.AddIns(strAddInName)
On Error GoTo 0
If Not addXL Is Nothing Then Exit Sub
'~~> This is required to avoid the Run-time error '1004':
'~~> "Unable to get the Add property of the AddIns class"
'~~> OR
'~~> "Add method of addins class failed"
'~~> when there are no workbooks
Set oTempBk = Workbooks.Add
Set addXL = AddIns.Add(strFilePath, True)
addXL.Installed = True
oTempBk.Close
ShouldIContinue = True
End Sub