I currently have a userform that has 3 options on printing. I want to be able to click a button, a msgbox appear with the options "yes" or "no" and if the user selects "yes", then run a sub program that's on sheet 4 (i have 2 sheets that are sheet4 and sheet2).I think the problem with the code right now is with "call slab", VBA inst recognizing the sub program "slab", this is the program that will print out my selected data.
Private Sub CommandButton1_Click()
If MsgBox("Do you want to continue?" & vbCrLf, vbYesNo) = vbYes Then
Call Slab
Else
docmd.Close commandButton_Click
End Sub
Declare the slab as public and it will be ok:
Private Sub CommandButton1_Click()
Select Case MsgBox("Do you want to continue?" & vbCrLf, vbYesNo)
Case vbYes
Slab
Case vbNo
'nothing
End Select
End Sub
Public Sub Slab()
MsgBox "Here is the SLAB"
End Sub
Related
This question already has answers here:
Disable Excel save option but allow macro save
(2 answers)
Closed 5 years ago.
I am writing a code that will prevent the user from saving the workbook, and it will only save when I want it to. This is to prevent the user from making changes and saving when they are not supposed to. I have created two private subs, but I don't know how to make an exception when the workbook is being saved on my own. I would like to be able to place the saving code in various macros so that I can control the save at any point.
The following is my code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "You can't save this workbook!"
Cancel = True
End Sub
Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String
MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
myValue = InputBox("Please input your email address:", "Input", "x#us.tel.com")
'Place your text here
MyNote = "Is this correct?: " & myValue
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
If Answer = vbNo Then
'Code for No button Press
GoTo Line
Else
Range("A1").Value = myValue
End If
ActiveWorkbook.Save
End If
End Sub
You may try something like this...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Environ("UserName") <> "YourUserNameHere" Then
MsgBox "You can't save this workbook!"
Cancel = True
End If
End Sub
Edit:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Ans As VbMsgBoxResult
Ans = MsgBox("You can't save this workbook!" & vbNewLine & _
"Do you have password to save the file?", vbQuestion + vbYesNo)
If Ans = vbYes Then
frmPassword.Show 'UserForm to accept the password
Else
Cancel = True
End If
End Sub
I added a public variable saveLock that I reference in the save cancel code. This allows me to lock and unlock the save inside of my code. If anyone has a better way please let me know, but this did solve the problem.
Public saveLock As Integer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If saveLock = 0 Then
Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String
saveLock = 0
MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
myValue = InputBox("Please input your email address:", "Input", "x#us.tel.com")
'Place your text here
MyNote = "Is this correct?: " & myValue
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
If Answer = vbNo Then
'Code for No button Press
GoTo Line
Else
Range("A1").Value = myValue
End If
saveLock = 1
ActiveWorkbook.Save
saveLock = 0
End If
End Sub
I am building a code which gives warning when the workbook is closed. By default excel warns only once (that too if current changes are not saved). I want warning to come twice. First time it should ask are you sure? when the person hits yes, again system should ask are you sure.
So far my code is as follows, but it is not working properly. With the below code, warning is only displayed once. Please can someone help?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim mbResult As Integer
Dim wkb As Workbook
Set wkb = ActiveWorkbook
mbResult = MsgBox("Are you sure you want to exit this program?", _
vbYesNo)
Select Case mbResult
Case vbYesNo
MsgBox "You are about to exit this program, are you sure?"
Case vbYes
Cancel = True
Case vbNo
' Do nothing and allow the macro to run
Exit Sub
End Select
End Sub
you can directly handle the return value of a MsgBox like this:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Select Case MsgBox("Are you sure you want to exit this file?", vbYesNo)
Case vbYes
Cancel = MsgBox("You are about to exit this program, are you sure?", vbYesNo) = vbNo
Case vbNo
Cancel = True
End Select
End Sub
or, which is equivalent:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = MsgBox("Are you sure you want to exit this file?", vbYesNo) = vbNo
If Not Cancel Then Cancel = MsgBox("You are about to exit this program, are you sure?", vbYesNo) = vbNo
End Sub
You could use a Workbook_BeforeClose event to prompt the user to check if they really want to do something.
Both these two codes below ask the user twice for confirmation if they want to close the workbook. The first one use the Workbook_BeforeClose event, so you will need to do something in the code to save changes etc.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("Are you sure you want to close the workbook?", vbYesNo, "User Input") = vbYes Then
If MsgBox("Are you relly sure you want to close the workbook?", vbYesNo, "User Input") = vbYes Then
Call MsgBox("No turning back now", vbOKOnly, "User Anwser")
End If
Else
Call MsgBox("That was close", vbOKOnly, "User Anwser")
End If
End Sub
This second set of code goes in a normal module and you could call it from your macro when you want the user to close the workbook. I have put in a workbook save so that changes are not lost.
Sub Close()
If MsgBox("Are you sure you want to close the workbook?", vbYesNo, "User Input") = vbYes Then
If MsgBox("Are you relly sure you want to close the workbook?", vbYesNo, "User Input") = vbYes Then
Call MsgBox("No turning back now", vbOKOnly, "User Anwser")
ActiveWorkbook.Close True
End If
Else
Call MsgBox("That was close", vbOKOnly, "User Anwser")
End If
End Sub
How it looks running,
#
updated codes
Function condition(ByRef objCmb As ComboBox)
If objCmb.Value ="" And objCmb.Value = "g" Then
Call MsgBox("gg", vbOKOnly, "error")
End If
End Function
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition (ComboBox1)
End Sub
'other codes for reference:
Private Sub CommandButton1_Click()
Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To 3
For j = 1 To 5
With Me.Controls("ComboBox" & (i - 1) * 5 + j)
If .Text <> "" Then
Cells(lastrow + i, j) = .Text
Else
Exit Sub
End If
End With
Next j
Next i
End Sub
I have 50 combo and text boxes in VBA user panel. As it is too troublesome to set constraints in every combo or text box, I want a function to apply to every combo and text box.
For the codes above , it shows up cant find objecterror
How to solve ?
Btw , how to set the function statement for textbox ?
is it Function condition2(ByRef objCmb As textbox)...
You are receiving an error because ComboBox is not ByRef objCmb As ComboBox. Don't use parenthesis when calling a sub. Don't use parenthesis when calling function if you are not using the functions return value. If a function does not return a value it should be a sub.
Sub condition(ByRef objCmb As MSForms.ComboBox)
If objCmb.Value <> "" And objCmb.Value = "g" Then
MsgBox "gg", vbOKOnly, "error"
objCmb.Value = ""
End If
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I wrote a function to help you generate the Exit event code for all your text and combo boxes.
Sub AddCodeToCipBoard(frm As UserForm)
Const BaseCode = " Private Sub #Ctrl_Exit(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf & _
" condition ComboBox1" & vbCrLf & _
" End Sub" & vbCrLf & vbCrLf
Dim s As String
Dim ctrl
Dim clip As DataObject
Set clip = New DataObject
For Each ctrl In frm.Controls
If TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "TextBox" Then
s = s & Replace(BaseCode, "#Ctrl", ctrl.Name)
End If
Next
clip.SetText s
clip.PutInClipboard
End Sub
Put this code in a module and call it like this:
AddCodeToCipBoard Userform1
Now all the Exit event code will be copied into the Windows Clipboard. Go into your Userforms code module and paste the new code.
Example Output:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
condition ComboBox1
End Sub
I have a delivery note spreadsheet that holds customer and product data. I want a button than when clicked Asks 'Do you want to Save as well as Print?'.
I have recorded a macro for the file to be saved that works fine when the module is run on its own but when it is all put together in the code below I get the following error: 'Compile Error: Expected End Sub'. The else part also runs fine on its own. How do I solve this error and get the code to run? Thanks
Private Sub CommandButton1_Click()
MsgBox "Do you want to Save as well as Print?", vbYesNo
If answer = vbYes Then
Sub mac_SaveNote()
ChDir "C:\Users\User\Desktop\DeliveryNotes"
ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\DeliveryNotes\" & Range("A11"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Else
Sheets("Note 1").PrintOut , Copies:=2 'prints 2 copies of note1
Range("A11:J16").ClearContents 'clears customer data
Range("A18:I42").ClearContents 'clears product data
End If
End Sub
Two ways:
Move the sub out of the first and simply call it:
Private Sub CommandButton1_Click()
MsgBox "Do you want to Save as well as Print?", vbYesNo
If answer = vbYes Then
mac_SaveNote
Else
Sheets("Note 1").PrintOut , Copies:=2 'prints 2 copies of note1
Range("A11:J16").ClearContents 'clears customer data
Range("A18:I42").ClearContents 'clears product data
End If
End Sub
Sub mac_SaveNote()
ChDir "C:\Users\User\Desktop\DeliveryNotes"
ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\DeliveryNotes\" & Range("A11"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Or just run the code as is and remove the Sub part
Private Sub CommandButton1_Click()
MsgBox "Do you want to Save as well as Print?", vbYesNo
If answer = vbYes Then
ChDir "C:\Users\User\Desktop\DeliveryNotes"
ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\DeliveryNotes\" & Range("A11"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
Sheets("Note 1").PrintOut , Copies:=2 'prints 2 copies of note1
Range("A11:J16").ClearContents 'clears customer data
Range("A18:I42").ClearContents 'clears product data
End If
End Sub
This macro is one that was not written by me, so I'm having trouble understanding the source of the error. I have a macro that's supposed to run on startup to adjust the ribbon to add a button, and another part to remove styles when you select that button. Currently, I get the message: Object variable or With block variable not set. When I select "Debug" it goes to the VBA screen and immediately gives me 3 more error pop-ups that say: Can't execute code in break mode.
The first part of this is the two subs that are to run on startup, which are:
Dim WithEvents app As Application
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Module1.MyRibbon.Invalidate
End Sub
Private Sub Workbook_Open()
Set app = Application
End Sub
It highlights the Module1.MyRibbon.Invalidateas the problematic bit. Personally I don't see anything wrong with this per se, but perhaps the problem is in the Module 1? That code contains three subs, as follows:
Public MyRibbon As IRibbonUI
'Callback for customUI.onLoad
Sub CallbackOnLoad(Ribbon As IRibbonUI)
Set MyRibbon = Ribbon
End Sub
'Callback for customButton getLabel
Sub GetButtonLabel(control As IRibbonControl, ByRef returnedVal)
If ActiveWorkbook Is Nothing Then
returnedVal = "Remove Styles"
Else
returnedVal = "Remove Styles" & vbCr &
Format(ActiveWorkbook.Styles.Count, "#" & Application.International(xlThousandsSeparator) & "##0")
End If
End Sub
Sub RemoveTheStyles(control As IRibbonControl)
Dim s As Style, i As Long, c As Long
On Error Resume Next
If ActiveWorkbook.MultiUserEditing Then
If MsgBox("You cannot remove Styles in a Shared workbook." & vbCr & vbCr & _
"Do you want to unshare the workbook?", vbYesNo + vbInformation) = vbYes Then
ActiveWorkbook.ExclusiveAccess
If Err.Description = "Application-defined or object-defined error" Then
Exit Sub
End If
Else
Exit Sub
End If
End If
c = ActiveWorkbook.Styles.Count
Application.ScreenUpdating = False
For i = c To 1 Step -1
If i Mod 600 = 0 Then DoEvents
Set s = ActiveWorkbook.Styles(i)
Application.StatusBar = "Deleting " & c - i + 1 & " of " & c & " " & s.Name
If Not s.BuiltIn Then
s.Delete
If Err.Description = "You cannot use this command on a protected sheet. To use this command, you must first unprotect the sheet (Review tab, Changes group, Unprotect Sheet button). You may be prompted for a password." Then
MsgBox Err.Description & vbCr & "You have to unprotect all of the sheets in the workbook to remove styles.", vbExclamation, "Remove Styles AddIn"
Exit For
End If
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
I've never written any Activation or Ribbon-related macro, so I have no idea where the error could be. The addin works just find regardless of this message, as the button gets added and it functions as it should when the file isn't a blank file, but I get the error pop-up and the button doesn't get created right on new, blank files. How could I fix this?
I simply deleted:
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Module1.MyRibbon.Invalidate
End Sub
No runtime errors on start of excel and no issues when using the script; counts fine and deletes fine. Windows 7, Excel 2010.