Info
I have a button that opens/close a spreadsheet. The button simply checks if a sheet is visible (after another spreadsheet opened) and then calls the specific function. I have two functions that either open a workbook, or close the workbook. Excel only crashes when setting the visibility or closing the workbook. If I run the code in the editor without clicking the button, everything works fine.
Code
Private Sub Main()
If Sheets("XYZ").Visible = True Then
Application.Run ("OFF")
Else
Application.Run ("ON")
End If
End Sub
Private Sub ON()
Dim Pfd As String
Pfd = ThisWorkbook.Path
Application.ScreenUpdating = False
Sheets("XYZ").Visible = True
Sheets("XYZ").Select
Application.DisplayAlerts = False
SendKeys ("mso2013")
SendKeys "~"
SendKeys ("mso2013")
SendKeys "~"
Application.DisplayAlerts = True
Workbooks.Open Filename:=Pfd & "\UserID\second.xlsx"
Workbooks("second.xlsx").Protect Structure:=False, Windows:=False, Password:="mso2013"
Workbooks("second.xlsx").Sheets("XYZ").Unprotect Password:="mso2013"
Windows("second.xlsx").Visible = True
Windows("second.xlsx").WindowState = xlMaximized
Application.ScreenUpdating = True
End Sub
Private Sub OFF()
Application.ScreenUpdating = False
Windows("second.xlsx").WindowState = xlNormal
Windows("second.xlsx").Visible = False
Workbooks("second.xlsx").Sheets("Stamm").Protect Password:="mso2013"
Workbooks("second.xlsx").Protect Structure:=True, Windows:=True, Password:="mso2013"
Workbooks("second.xlsx").Close savechanges:=True
Sheets("XYZ").Visible = xlVeryHidden
Sheets("ADMIN").Select ' Admin is the sheet where the button is located
ActiveWindow.WindowState = xlMaximized
Application.ScreenUpdating = True
End Sub
I've tried timers, a button that just calls the OFF method, close without save, etc...
The problem is that it needs to be .visible = false and therefore I can't remove this line (without the line it would work like it should..).
Solved:
The problem was that I used a (ActiveX) Command Button instead of a normal button. No problems occurred with Excel 2010.
Related
I am writing a short script compiling other macros.
It allows me to run three macros at once if I want to, rather than each one one by one.
I don't want to have the reply to the message boxes in the other 3 macros. The default answer is fine.
I am using the Application.DisplayAlerts = False method. Here:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Run "Mod_Patients.MettreDatesAJourPatients"
Application.Run "Mod_Prescripteurs.MettreDatesAJourPrescripteurs"
Application.Run "Mod_Services.MettreDatesAJourServices"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Data has been updated"
Only that the Application.DisplayAlerts false/true does not work.
The subsequent message boxes appear.
I can't find a workaround.
Here's what Scott is suggesting:
Sub MettreDatesAJourPatients(Optional WarnUser as Boolean = True)
'....
'....
If WarnUser Then Msgbox "Something something..."
'....
End Sub
When called with no arguments WarnUser will be True: if you want to suppress any messages then call with:
MettreDatesAJourPatients False
I am trying to dismiss pop up password boxes while my macro is running, each file is password protected which i have code for to unlock these however the files also are linked to other password protected files that excel prompts me for a password, instead of clicking cancel every time one of these boxes pops up is there a way to dismiss the password boxes in the macro?
Here is my current code:
Sub OpenCurrentGBP()
cdirectory = Range("E5").Value
Mdirectory = Range("E6").Value
cGap = Range("E11").Value
cEVE = Range("E12").Value
cHedge = Range("E13").Value
cVarFile = Range("E16").Value
cGapMovements = Range("E17").Value
cQRMCheck = Range("E18").Value
GapPwd = Range("E42").Value
EVEPwd = Range("E43").Value
HedgePwd = Range("E44").Value
EurogapPwd = Range("E45").Value
EuroEVEPwd = Range("E46").Value
VarPwd = Range("E47").Value
MovPwd = Range("E48").Value
Application.DisplayAlerts = False
Call OpenFile(cdirectory, cGapMovements, MovPwd)
Call OpenFile(cdirectory, cGap, GapPwd)
Call OpenFile(cdirectory, cEVE, EVEPwd)
Call OpenFile(cdirectory, cHedge, HedgePwd)
Call OpenFile(cdirectory, cVarFile, VarPwd)
Call OpenFile(cdirectory, cQRMCheck)
Application.DisplayAlerts = True
End Sub
The OpenFile Macro is as follows:
Sub OpenFile(Directory, File, Optional Pass)
On Error GoTo Failure
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
If IsMissing(Pass) = 0 Then
Workbooks.Open Filename:= _
Directory & "\" & File, Notify:=False, Password:=Pass
Else
Workbooks.Open Filename:= _
Directory & "\" & File, Notify:=False
End If
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Exit Sub
Failure: MsgBox (File & " could not be opened")
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub
Inside the subs you call (Next time you should show them here too) to open the protected Workbooks you need to use the Workbooks.open statment and I have an example of my own codes that I am using to open workbooks with password:
Workbooks.Open Filename:=tmp_file_p, Password:="7399"
tmp_file_p is a string variable with the path and the name of the workbook.
I have some VBA code that formats/resizes the screen when the workbook/worksheet is activated.
The code is as follows:
Private Sub Workbook_Activate()
Dim SaveSelection As Object
Set SaveSelection = Selection
Application.ScreenUpdating = False
Range("A1:T50").Select
ActiveWindow.Zoom = True
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
Range("A1:T50").Select
ActiveWindow.Zoom = True
On Error GoTo ExitPoint
SaveSelection.Select
Application.ScreenUpdating = True
ExitPoint:
End Sub
The problem here is that when the user first opens the workbook, they get this Security Warning message "Macros have been disabled", so the macro does not run when the user first opens the workbook because the message appears.
Does anyone know of a workaround to this?
This can often be resolved by including the workbook's folder path in their Trusted Locations.
As sigil pointed out adding the file's folder location to the Trusted Locations will prevent the Enable Content and Enable Macros dialog boxes from appearing.
Alternately, you could create a VBScript file to open the workbook.
Paste this could into NotePad
Adjust the FILE_NAME constant
Hold down Ctrl+S
Click [Save as type]
Select All Files (.)
Save the file with .vbs as it's extension
Const FILE_NAME = "C:\Excel FIles\Hello World.xlsm"
Dim oExcel
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
On Error Goto 0
If TypeName(oExcel) = "Empty" Then Set oExcel = WScript.CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.Workbooks.Open FILE_NAME
I am trying to figure out why this "Delete Method of Range Class" error is popping up. It does not always occur when this macro runs, which makes it all the more perplexing.
Can anybody explain this?
Sub ResetSheet()
If WindowsOS Then
'*******************************************************************************************************'
'Resets the Data sheet. Called by the resetSheetButton procedure (located in module: m7_Macros1_5). '
'Also called by the OkCommandButton_Click procedure in the OnOpenUserForm form. '
'*******************************************************************************************************'
Application.EnableEvents = False
Sheet4.Visible = True
Sheet4.Activate
Sheet4.Select
Sheet4.Rows("2:101").Select
Selection.Copy
'TC Edit
Sheet1.Activate
Sheet1.Range("A2").PasteSpecial (xlPasteAll)
'Sheet1.Paste
Sheets("Data").Select
Sheet1.Rows("102:10000").EntireRow.Delete
Sheet4.Visible = False
'TC Edit 2.0 - Adding code to reset the exception checkboxes
If WindowsOS Then
Call resetCheckBoxes
End If
Application.EnableEvents = True
This is the macro code that causes the error (sometimes)
This is the error pop-up
try with below simplified code
Sub ResetSheet()
'If WindowsOS Then
Application.EnableEvents = False
With Worksheets("Sheet4")
.Visible = True
.Rows("2:101").Copy Worksheets("Sheet1").Range("A2")
End With
With Worksheets("Sheet1")
.Rows("102:101").EntireRow.Delete
End With
Worksheets("Sheet4").Visible = False
If windowsOS Then
Call resetCheckBoxes
End If
Application.EnableEvents = True
End Sub
When a user opens my VBA program it hides all Excel's command bar's and whatnot so it looks as if my program is not running in Excel at all. Since this action will take place across all instances of Excel I found some code that will check if other programs are open, and if so save my program as a temp file and reopen it in a new instance of Excel.
The problem though is when it opens it doesn't fire off the Workbook_Open event. As a temporary fix I've put a button on a spreadsheet that runs the macro to launch the program but I need to do better than this. Can you take a look at the code at this site and let me know why the Workbook_Open event is not firing? (as you can see I've already asked the forum twice for help on it with no response).
Updated with code
The code that duplicates the program and opens the new instance is in the UserForm section of code at the bottom.
Placed in ThisWorkbook:
Private Sub Workbook_Open()
Set clsAPP.XLAPP_ORIG = Application
If Application.UserControl Then
If Application.Workbooks.Count > 1 Then
Application.Visible = False
DoEvents
frmCreateReplicant.Show vbModal
End If
End If
Call ThisWorkbook_CompleteOpening
End Sub
Placed in standard module:
Option Explicit
Public XLAPP_Copy As New Excel.Application, _
clsAPP As New clsXLApp
Public Sub ThisWorkbook_Open()
Dim intMaxRow As Integer
If Application.Workbooks.Count > 1 Then
Application.Visible = False
DoEvents
frmCreateReplicant.Show vbModal
'Call ThisWorkbook_CompleteOpening
Else
ThisWorkbook_CompleteOpening
End If
ThisWorkbook.Saved = True
Delay
End Sub
Sub ThisWorkbook_CompleteOpening(Optional Fake)
'MsgBox "...Any other OnOpen code here..."
End Sub
Function Delay(Optional SecondFraction As Single = 0.2)
Dim sngTimeHack As Single, dtmDate As Date
sngTimeHack = Timer: dtmDate = Date
If sngTimeHack + SecondFraction < 86400 Then
Do
DoEvents
Loop While Timer < (sngTimeHack + SecondFraction)
Else
If dtmDate = Date Then
Do
DoEvents
Loop While dtmDate = Date
End If
sngTimeHack = (sngTimeHack + SecondFraction) - 86400
If DateAdd("d", 1, dtmDate) = Date Then
Do
DoEvents
Loop While Timer < sngTimeHack
End If
End If
End Function
Function KillMeBasic()
With ThisWorkbook
.Saved = True
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close False
End With
End Function
Placed in class module:
Option Explicit
Public WithEvents XLAPP_ORIG As Application
Private Sub XLAPP_ORIG_NewWorkbook(ByVal Wb As Workbook)
Wb.Close False
MsgBox MsgTxt(1), 64, vbNullString
End Sub
Private Sub XLAPP_ORIG_WorkbookOpen(ByVal Wb As Workbook)
If Not Wb.Name = ThisWorkbook.Name Then
Wb.Close False
MsgBox MsgTxt(2), 64, vbNullString
End If
End Sub
Private Function MsgTxt(Opt As Long) As String
Select Case Opt
Case 1
MsgTxt = _
"Sorry, you cannot create a new workbook here." & vbCrLf & _
"You can start a new instance of Excel by..."
Case 2
MsgTxt = _
"You cannot open another workbook here. You" & vbCrLf & _
"can open another workbook by first..."
End Select
End Function
Placed in UserForm:
Private Sub UserForm_Activate()
Dim strThisWorkbookFullname As String
Dim wbMeCopy As Workbook
Delay 0.05
Set XLAPP_Copy = CreateObject("Excel.Application")
strThisWorkbookFullname = ThisWorkbook.FullName
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\00000000001.xls", _
Password:="NeedKilled", AddToMru:=False
Application.DisplayAlerts = True
Do While ThisWorkbook.Saved = False
Loop
Delay 0.2
XLAPP_Copy.Workbooks.Open Filename:=strThisWorkbookFullname, AddToMru:=False
Do
On Error Resume Next
Set wbMeCopy = XLAPP_Copy.Workbooks(1)
On Error GoTo 0
Loop While wbMeCopy Is Nothing
Set wbMeCopy = Nothing
Delay 0.1
Application.Visible = True
XLAPP_Copy.Visible = True
Unload Me
Delay
Call KillMeBasic
End Sub
Private Sub UserForm_Initialize()
With Me
.BackColor = &H0&
.Caption = ""
.ForeColor = &H0&
.Height = 123
.Width = 240
With .lblMsg
.BackColor = &H0&
.Caption = String(2, vbCrLf) & _
"Please wait, I am protecting the program..."
With .Font
.Name = "Century Gothic"
.Size = 10
End With
.ForeColor = &HC000C0
.Height = 90
.Left = 6
.TextAlign = fmTextAlignCenter
.Top = 6
.Width = 222
End With
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu _
Then Cancel = True
End Sub
This works to hide the Ribbon/command bars (although the File or Backstage menu is still present, thought I think you may be able to disable this I have not tried yet), if you are hiding other stuff like the StatusBar, etc., it may not be enough to solve your problem, but here it is anyways.
Using the CustomUI editor, open the XLSM file.
Note: The XLSM file should not be open in any instance of Excel when you are opening it through the Custom UI Editor. If it is open in Excel, the modifications to the XML will not be saved properly.
Once you have the file open in the CustomUI Editor, you'll see this:
From the menu, Insert Office 2010 Custom UI Part:
Then copy and paste this XML:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon startFromScratch="true" />
</customUI>
Finally, save & close the file through the CustomUI Editor, then re-open in Excel. You should see that the while this file/workbook is active, the ribbon does not exist.
But, if you switch to another Workbook file, the ribbon will re-appear while that file is active.
The startFromScratch property makes it so that when this Workbook has focus, the only ribbon elements which are displayed to the user, within the Application's window, are those which are defined within the XML, which as you can probably gather in the snippet above, are none.
This also entirely avoids the need to try and open copies of the file in a new instance of Excel Application, which (unless you have some other quirky requirements) seems unnecessarily cumbersome and problematic.