We have a macro addin in our company that I cannot run on one computer (on another computers it runs correctly) with Automation error Exception occured. Can you please tell me where is the mistake ?
Sub importFromActiveSheet()
If ActiveSheet Is currDoc Then
MsgBox "You cannot import data from current document" & vbNewLine & vbNewLine & "Please select other file", vbCritical, "Wrong source data file"
Exit Sub
End If
....
Property Get currDoc() As Worksheet 'returns current document worksheet in tool
Set currDoc = ThisWorkbook.Sheets(1)
End Property
The error will pop up at the sentence :
Set currDoc = ThisWorkbook.Sheets(1)
After this the excel will fall down.
Can you help me please ?
Related
I have an issue that I'm trying to resolve regarding the creation of a custom error message. I have a monthly workbook that we use to enter daily sales totals, and after each day we use a macro that locks all the cells and protects it from editing.
I want to create a custom error message when some one tries to edit the form.
I have found several solutions, but I cannot get them to work.
Here is what I have tried:
On each page I have this code to call the error:
Private Sub OnError()
If Target.Locked Then
Call ThisWorkbook.OnError
End If
End Sub
And in the ThisWorkbook page I created this sub to create the error code (copied and pasted from another forum):
Option Explicit
Sub Worksheet_Selection(ByVal Target As Range)
' Page lockout error code Visual Basic control
' Custom error code
Dim goodRng As Range
Dim wSheet As Worksheet
Set wSheet = ActiveSheet
If Target.Locked Then
Application.EnableEvents = False
wSheet.Locked = False
Application.EnableEvents = True
MsgBox "This day is closed." & vbNewLine & vbNewLine & _
"The day has been closed and" & vbNewLine & _
"further editing is prohibited!" & vbNewLine & _
"Thank you", vbCritical, "STOP!"
End If
End Sub
I have tried various iterations of this and am unable to get the error box to work. How can I get this to work?
I am a VBA novice.
Code edited due to new information from OP. Sounds like he is after code for a single sheet. Don't use the Worksheet_Activate code if it is not required and put the code in the relevant Sheet module, not ThisWorkbook module.
Private Sub Worksheet_Activate()
Call ShowCustomErrorMessage
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call ShowCustomErrorMessage
End Sub
Private Sub ShowCustomErrorMessage()
Application.EnableEvents = False
With ActiveSheet
.Unprotect Password:="1234" 'Edit to suit
.Cells.Locked = True
.Protect Password:="1234" 'Edit to suit
End With
Application.EnableEvents = True
MsgBox "This day is closed." & vbNewLine & vbNewLine & _
"The day has been closed and" & vbNewLine & _
"further editing is prohibited!" & vbNewLine & _
"Thank you", vbCritical, "STOP!"
End Sub
Im working on building out a VBA-based app that will have around 150 users. They will all have their own data files, tables, custom views, etc. But I will need to regularly update the code behind the app. So Im using the two-workbook technique where their unique User Workbooks (call them the UWs) all pass control to a Code Workbook (call it CW) which contains all the code. That way, when I need to update, I update the CW, and everyone simply replaces the old CW in their folders with the new one and their UWs remain the same.
My problem is that I'd like the CW to essentially remain hidden and protected. But with macro security, when they open their UWs after the update and it immediately calls the startup subroutine in the new CW, it won't run. They have to first open the CW (which I don't want!) and make it a trusted document before opening their UWs will run the startup subroutine in the CW.
It shouldn't matter, but here is the only code in the UWs (note this is still in prototyping/early stages so everything is called 'Test'!):
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Workbooks("Test CW.xlsm").Close
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
'Checks to see if TestCW is present next to Test UW
On Error Resume Next
X = Workbooks("Test CW.xlsm").Name 'Sets X to name of workbook; if its not there this will throw an error and Err <> 0
If Not (Err = 0) Then 'If there's no error
On Error GoTo CWFileError
Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Test CW.xlsm" 'Opens Test CW if in same folder
'Makes Test CW hidden
Workbooks("Test CW.xlsm").Windows(1).Visible = False
End If
On Error GoTo 0
'Runs test module in Test CW, then returns control to here
With Application
.ScreenUpdating = True
.Run "'Test CW.xlsm'!ThisWorkbook.TestStart" 'Uses ThisWorkbook.TestSTart as TestStart is a Workbook-level subroutine in the ThisWorkbook module
End With
ThisWorkbook.Activate
Exit Sub
CWFileError:
MsgBox "Your SVEDash application file named Test CW is not in this folder." _
& vbCrLf _
& "Please locate your current SVEDash application file and place it in this folder." _
& vbCrLf _
& "This file will close to prevent damage to your data."
On Error GoTo 0
ThisWorkbook.Close
End Sub
Any ideas on how I can bypass this security issue without the users having to change their security settings?
This seemed to only be an issue with the first 'Updte'. As I copied newer 'updated' CW into the folder, as long as I kept the name consistent the previous trusted status of the former file with that name was remembered. Hopefully thats an actual solution
I'm trying to run a macro to clear my workbook of hidden names so when a tab is copied I don't have to hold down enter for 5 minutes because of all of the hidden names.
I looked around for some VBA code to accomplish this but am getting the error:
"Run-time error '1004': The syntax of this name isn't correct."
I assume it's running into an invalid name so it can't delete it?
Code below:
Sub Remove_Hidden_Names()
Dim xName As Variant
If MsgBox("Do you really want to delete all hidden names in this workbook?", vbQuestion + vbYesNoCancel, "Delete hidden names?") = vbYes Then
For Each xName In ActiveWorkbook.Names
If xName.Visible = False Then
xName.Delete
End If
Next xName
MsgBox "All hidden names in this workbook have been deleted.", vbInformation + vbOKOnly, "Hidden names deleted"
End If
End Sub
Seems like there might be an invalid or corrupted name, the box shouldn't allow for dashe or hyphens. You could try to open the XML of the worksheet, find the invalid name and change it to a valid one.
I need a simple error handling code for my small macro, I have search the web but have nothing simple, seems to be all very complicated.
I down load sales reports in .txt form on a weekly basis, I run separate macro to do stuff and then add to a master page. Not every week do sales reports download as there may not have been sales for that particular region.
I need a simple error handler so that if it does not find the report, it moves to the next sub.
Any help appreciated
Sub MXM_POS()
Workbooks.OpenText Filename:="C:\Users\903270\Documents\Excel\MXMPOS*.txt"
‘Run macro code
Run ("DLK_POS")
End Sub
Here is a simple basic structure that you can expand on as needed:
Sub MXM_POS()
On Error GoTo ErrHandler
' code here
ExitSub:
' shutdown code here
Exit Sub
ErrHandler:
If Err.Number <> 0 Then
Dim mbr As VbMsgBoxResult
mbr = MsgBox( _
"Error #" & Err.Number & ": " & Err.Description & vbNewLine & _
"Would you like to continue?", vbExclamation Or vbYesNo)
If mbr = vbYes Then Resume ExitSub
Application.Quit
End If
End Sub
When I desire a stack dump I construct that within the Source property of the Err object using concatenation with a newline, and then only display the MsgBox result at the top of the calling stack, usually either the Event Handler that launched the code or the top-level macro invoked by the user.
My Excel AddIn is written in C#, it uses Excel DNA, AddIn Express RTD, NetOffice
Installer is created with Advanced Installer, plus VBA
the VBA code is in install.xls
Private Sub Workbook_Open()
Dim quit As Integer
Dim added As Boolean
Add_Addin
If Workbooks.Count = 1 Then
Application.quit
Else
Me.Close
End If
End Sub
Private Sub Add_Addin()
On Error GoTo ERR_
Dim addinFile As String
addinFile = ThisWorkbook.Path & "\" & "MyAddIn.xll"
If Len(addinFile) > 0 Then
Dim LEA As AddIn
Set LEA = Application.AddIns.Add(addinFile)
If (Not LEA Is Nothing) Then
LEA.Installed = True
Else
MsgBox "Failed to add XLL"
End If
Else
MsgBox "XLL file not found"
End If
Exit Sub
ERR_:
MsgBox ("Error " & Err.Number & " " & Err.Description)
End Sub
Everything works fine. and I did not change installer
Now when one user installs new version of my addin,
when install.xls is run in Excel, a window pops up saying "insert smart card"
I think and think and figure out the only thing changed (compared with previous version) is digital sigature of the install.xls b/c the previous signature file expired recently
I signed install.xls with the new certificate
Now the strange window pops up during install.
Anyone know how to solve this?
Thanks
Perhaps you can try following the instructions on the link below for adding a trusted location.
http://office.microsoft.com/en-us/word-help/add-remove-or-modify-a-trusted-location-for-your-files-HA010354311.aspx#BM1
This is a fix I am pursuing for a similar issue.