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
Related
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
I have the following problem:
To save the Worksheet in a .txt file, I wrote this sub:
Sub SaveFile()
Dim ans As Long
Dim sSaveAsFilePath As String
Dim VPname As String
VPname = Worksheets(3).Cells(2, 1)
On Error GoTo ErrHandler:
sSaveAsFilePath = ActiveWorkbook.Path & "\" & VPname & ".txt"
If Dir(sSaveAsFilePath) <> "" Then
ans = MsgBox("Datei " & sSaveAsFilePath & " existiert bereits. Überschreiben?", vbYesNo + vbExclamation)
If ans <> vbYes Then
Exit Sub
Else
Kill sSaveAsFilePath
End If
End If
Worksheets(3).Copy '//Copy sheet 3 to new workbook
ActiveWorkbook.SaveAs sSaveAsFilePath, xlTextWindows '//Save as text (tab delimited) file
If ActiveWorkbook.name <> ThisWorkbook.name Then '//Double sure we don't close this workbook
ActiveWorkbook.Close False
End If
MsgBox ("Worksheet wurde erfolgreich als txt-Datei gespeichert!")
My_Exit:
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume My_Exit
End Sub
In this worksheet, the cells with text content have to have quotation marks (e.g. "example"). When I open the .txt-file, all these entrys have three quotation marks instead of one ("""example""").
Do you know how to fix this?
Thanks a lot :)
Welcome to stackoverflow! It is really useful, to make a small question, that is replicable by the others - read more here - https://stackoverflow.com/help/mcve Thus, it would be easy for you to search as well.
In your case, a minimal and verifyable example would be like this:
Option Explicit
Public Sub TestMe()
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\new1.txt", _
FileFormat:=xlTextWindows
End Sub
Then, if you use the search engine, you would find that there is already some answer of it here:
Saving a Excel File into .txt format without quotes
:)
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.
I have a spreadsheet with 6 userforms, used on about 30 computers. The VBA code is password protected. Often when we close the sheet, the VBA project password box appears and excel.exe remains in task manager.
I have done a bit of testing and come up with the following:
The problem only occurs when a userform has been opened.
Nothing needs to be done with the userform to cause the popup other than to press Cancel (which calls Unload Me)
The Workbook_BeforeClose event is as follows:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
'Cancel autosave
Sheets("BOH General").Range("A102").Value = 0
AutoSaveTimer
'Application.EnableEvents = False
If Not Sheets("START").Visible = True Then Call CostingMode
Call BackItUp
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
And here are some other macros called by Workbook_BeforeClose:
Sub AutoSaveTimer()
If Sheets("BOH General").Range("A102").Value > 0 Then
RunWhen = Now + TimeSerial(0, Sheets("BOH General").Range("A102").Value, 0)
Application.OnTime EarliestTime:=RunWhen, Procedure:="AutoSaveIt", _
Schedule:=True
Else
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="AutoSaveIt", _
Schedule:=False
On Error GoTo 0
End If
End Sub
Sub AutoSaveIt()
ThisWorkbook.Save
Call AutoSaveTimer
End Sub
Sub BackItUp()
'Dont run if unsaved
If Sheets("BOH General").Range("A111").Value = "" Then Exit Sub
'Prompt
If MsgBox("Do you want to backup this sheet now (recommended if you made any changes)?", vbYesNo) = vbNo Then Exit Sub
'reformat date
Dim DateStamp As String
DateStamp = Format(Now(), "yyyy-mm-dd hh-mm-ss")
On Error Resume Next
MkDir ActiveWorkbook.Path & "\" & "Backup"
On Error GoTo 0
ActiveWorkbook.SaveCopyAs (ActiveWorkbook.Path & "\" & "Backup" & "\" & ActiveWorkbook.Name & " - backup " & DateStamp & ".xlsb")
ActiveWorkbook.Save
End Sub
Is this a userform error, is the userform not closing properly? Or is it something else?
UPDATE: This error only occurs after the user clicks the excel close button (top right) clicking File>Close does not produce the error.
Interesting that I have been experiencing the same instance, it has only cropped up recently as well. Did a version of MOS change this behavior? I have users on Excel 12.0.6611.1000 and 12.0.6712.5000 that do not get this error, on 12.0.6729.5000 it always occurs.
Edit;
I resolved this issue on my end today after discovering that several users had 'Drop Box' installed. Uninstalling or turning off drop box just prior to closing the application resolved the issue.
The macro ,upon opening the workbook, will look to see if cell "C27" contains any of the following Text: Location1, Location2, Location3, or Location4. If they do then it will continue to save 2 copy files of the template by those locations. If not then it will open a UserForm To select the correct location from a ComboBox.
How could i reset the check after the UserForm is closed, I tried Call Auto_Open after the Unload me but it didnt work.
Macro
Sub Auto_Open()
With Range("B30")
.Value = Time
.NumberFormat = "h-mm-ss AM/PM"
End With
Dim FileName As String
Dim FilePath As String
Dim FileDate As String
Select Case Range("C27").Value
Case "Location1", "Location2", "Location3", "Location4"
FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test"
FileName = Sheets("Data").Range("C27").Text
Application.DisplayAlerts = False
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName
Dim FileCopyName As String
Dim FileCopyPath As String
Dim FileTime As String
FilePath = "C:\Users\aholiday\Desktop\Backup"
FileName = Sheets("Data").Range("C27").Text
FileTime = Sheets("Data").Range("B30").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & Space(1) & FileTime & ".xlsx", FileFormat:=xlOpenXMLWorkbook
MsgBox "File was saved! Ready for Next Test, Please Exit."
Case Else
MsgBox "File was not saved, Please Insert The Correct Testing Location"
UserForm.Show
Exit Sub
End Select
Application.DisplayAlerts = True
End Sub
UserForm
Private Sub UserForm_Initialize()
'Empty TestLocation Box
TestLocation.Clear
'Fill TestLocation Box
With TestLocation
.AddItem "Location1"
.AddItem "Location2"
.AddItem "Location3"
.AddItem "Location4"
End With
End Sub
'---------------------
Private Sub Insert_Click()
Sheets("Data").Activate
Range("C27").Value = TestLocation.Value
End Sub
'--------------------
Private Sub CloseBox_Click()
Unload Me
End Sub
By using the following code for the insert button:
Private Sub Insert_Click()
Sheets("Data").Range("C27").Value = TestLocation.Value
Auto_Open
End Sub
The code will work (tested it), as long as you have the Auto_Open code in a module.
If you put the Auto_Open sub in the ThisWorkbook then move it to the module.
Then use the following code in ThisWorkbook:
Private Sub Workbook_Open()
Auto_Open
End Sub
Also:
Case "Location1", "Location2", "Location1", "Location4"
Should be:
Case "Location1", "Location2", "Location3", "Location4"