if-statement with two conditions is ignored - excel

It´s probably a too easy question for a forum, but I´m kinda hard stuck and my prog skills are very limited. After submitting a userform in vba, I want the program to check if the user made a logic mistake. There are several CheckBoxes and a combination of selections is possible, but not all combinations are allowed. So I have written the following code to prevent the user from submitting the form with selecting two specific CheckBoxes.
But the program completely ignores this if-statement and no matter what CheckBoxes are selected, nothing changes.
If userform1.CheckBoxOption3.Value = True And userform1.CheckBoxOption7.Value = True Then
MsgBox "This Combination is not possible!", vbCritical
Exit Sub
End If
Am I missing something obvious?
Edit: Additional Code:
Private Sub CmdFertig_Click()
Worksheets("sheets1").Range("I22").Value = userform1.TextBox1.Value & "°"
Worksheets("sheets1").Range("I13").Value = userform1.TextBox2.Value & "°"
Worksheets("sheets1").Range("E17").Value = userform1.TextBox3.Value & "°"
If userform1.CheckBox1.Value = True Then
Worksheets("sheets1").Range("g24").Value = userform1.TextBox1.Value & "°"
End If
If userform1.CheckBox2.Value = False Then
Worksheets("sheets1").Range("f24").Value = ""
Worksheets("sheets1").Range("f25").Value = ""
End If
If userform1.CheckBox3.Value = True Then
Worksheets("sheets1").Range("g25").Value = "Wechselseitig"
End If
If userform1.CheckBox5.Value = True Then
Worksheets("sheets1").Range("g25").Value = "Einseitig"
End If
If userform1.CheckBox7.Value = True Then
Worksheets("sheets1").Range("h25").Value = "Im UZ voreilend"
End If
If userform1.CheckBox3.Value = True And userform1.CheckBox7.Value = True Then
MsgBox "This Combination is not possible!", vbCritical
Exit Sub
End If
userform1.Hide
Worksheets("sheets1").ExportAsFixedFormat _
Type:=xlTypePDF, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
Filename:=userform1.Text1.Value & ".pdf", _
OpenAfterPublish:=True
Dim sPath As String
sPath = "O:\F1\completed\"
With Worksheets("sheets1")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPath & userform1.TextBox1.Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
SetAttr sPath & userform1.TextBox1.Value & ".pdf", vbReadOnly
End Sub

As a first step like suggestd in my comments I would remove the references to the default instance in the code itself. Like written here
A UserForm is essentially a class module with a designer and a
VB_PredeclaredId attribute. That PredeclaredId means VBA is
automatically creating a global-scope instance of the class, named
after that class.
UserForm1.Show at the call site, where UserForm1 isn’t a local
variable but the “hey look it’s free” default instance, which means
you’re using an object without even realizing it (at least without
New​-ing it up yourself) – and you’re storing state that belongs to a
global instance, which means you’re using an object but without the
benefits of object-oriented programming.
So removing all references to the default instance in the code might already help. For the posted code
Private Sub CmdFertig_Click()
Worksheets("sheets1").Range("I22").Value = TextBox1.Value & "°"
Worksheets("sheets1").Range("I13").Value = TextBox2.Value & "°"
Worksheets("sheets1").Range("E17").Value = TextBox3.Value & "°"
If CheckBox1.Value = True Then
Worksheets("sheets1").Range("g24").Value = TextBox1.Value & "°"
End If
If CheckBox2.Value = False Then
Worksheets("sheets1").Range("f24").Value = ""
Worksheets("sheets1").Range("f25").Value = ""
End If
If CheckBox3.Value = True Then
Worksheets("sheets1").Range("g25").Value = "Wechselseitig"
End If
If CheckBox5.Value = True Then
Worksheets("sheets1").Range("g25").Value = "Einseitig"
End If
If CheckBox7.Value = True Then
Worksheets("sheets1").Range("h25").Value = "Im UZ voreilend"
End If
If CheckBox3.Value = True And CheckBox7.Value = True Then
MsgBox "This Combination is not possible!", vbCritical
Exit Sub
End If
Hide
Worksheets("sheets1").ExportAsFixedFormat _
Type:=xlTypePDF, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
Filename:=Text1.Value & ".pdf", _
OpenAfterPublish:=True
Dim sPath As String
sPath = "O:\F1\completed\"
With Worksheets("sheets1")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPath & TextBox1.Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
SetAttr sPath & TextBox1.Value & ".pdf", vbReadOnly
End Sub
I also suggest to read about
VBA Userform
Addvanded Tips on Userform

Related

Convert excel columns towards different pdf pages

Below you can find my code that is working for a certain area. But I want to add a new element in the code but I can't find it how I can do it. The first area is A1:E42, but now I have one worksheet where I have 3 area. A1:E42, H1:K42 and O1:R42). How do I need to rewrite my code that the first area comes on the first pdf page, the second area on the second page et cetera.
Sub SavePDF()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.PrintArea = "A1:E42"
End With
Set ws = Nothing
Sheets("Offerte_M").ExportAsFixedFormat x1TypePDF, Filename:= _
"C:\Intel\" & ActiveSheet.Range("F21").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "Offerte has been saved as PDF. Press send now."
I thought maybe this was the correct way, but that doesn't work also.
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Offerte_M.PageSetup.PrintArea = "A1:E42"
Offerte_M.PageSetup.PrintArea = "H1:K42"
Offerte_M.PageSetup.PrintArea = "O1:R42"
Worksheets(Array("Offerte_M")).Select.ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Intel\" & ActiveSheet.Range("F21").Value & ".pdf", _
OpenAfterPublish:=True
Offerte_M.PageSetup.PrintArea = ""
Offerte_M.PageSetup.PrintArea = ""
Offerte_M.PageSetup.PrintArea = ""
Offerte_M.Select
Application.ScreenUpdating = True
End Sub

VBA Excel Error Run-Time error 53-file not found

this code used to run perfectly now is having time error 53, file not found. Not sure what is wrong
Sub printxxx()
' Print_quote XXX Macro
ActiveSheet.PageSetup.Orientation = xlLandscape
Worksheets("Quote").PageSetup.PrintArea = "$H$6:$Z$133"
strFile = ThisWorkbook.Path & "\" & strFile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & CreateObject("Scripting.FileSystemObject").GetFile(ThisWorkbook.FullName).ParentFolder.Name & " XXXQuote ", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
ActiveSheet.PageSetup.Orientation = xlPortrait
End Sub

Error assigning to a Range: Wrong number of arguments

I need to loop through named worksheets creating a pdf from each sheet and saving it to a folder.
Have so far created the below and its getting stuck saying wrong number of arguments.
It gets stuck at '3 Pages If Range("B16") = "3 page Statement" Then Range - it then says
"Wrong number of arguments or invalid property assignment"
Using Win 7 and Excel 2010
Sub CreatePDFs_Click()
' CreatePDF_Statements
'
' Create a PDF from the current sheet and save to folder
Dim DestFolder As String, PDFFile As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim ws As Worksheet
Dim sheet_name As Range
'Loop
For Each sheet_name In Sheets("Info").Range("A:A")
If sheet_name.Value = "" Then
Exit For
Else
Sheets(sheet_name.Value).Select
ws.Activate
OpenPDFAfterCreating = False 'Change this if you want to open the PDF after creating it : TRUE or FALSE
AlwaysOverwritePDF = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
DestFolder = Sheets("Dashboard").Range("M4")
'Customer Name stored in B8
CustomerName = Left(ActiveSheet.Range("B8").Value, InStr(1, ActiveSheet.Range("B8").Value, " ") + 50)
'Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & CustomerName & ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If AlwaysOverwritePDF = False Then
OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Else
On Error Resume Next
Kill PDFFile
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
'Create the PDF
'0 Page
If Range("B16") = "0 page Statement" Then
Range("B2:I50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'1 Page
If Range("B16") = "1 page Statement" Then
Range("B2:I50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'2 Pages
If Range("B16") = "2 page Statement" Then
Range("B2:I50,K2:R50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'3 Pages
If Range("B16") = "3 page Statement" Then
Range("B2:I50,K2:R50,T2:AA50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'4 Pages
If Range("B16") = "4 page Statement" Then
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'5 Pages
If Range("B16") = "5 page Statement" Then
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50,AL2:AS50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
Cancel = True
End If
Sheets("Dashboard").Select
Range("A1").Select
End Sub
Distilling the error message...
"Wrong number of arguments or invalid property assignment"
... the problem is that you are trying to pass 3+ arguments to Range, which can at most take 2. You want to combine each different area within a single range reference.
Change
Range("B2:I50", "K2:R50")
...
Range("B2:I50", "K2:R50", "T2:AA50")
...
Range("B2:I50", "K2:R50", "T2:AA50", "AC2:AJ50")
...
Range("B2:I50", "K2:R50", "T2:AA50", "AC2:AJ50", "AL2:AS50")
to
Range("B2:I50,K2:R50")
...
Range("B2:I50,K2:R50,T2:AA50")
...
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50")
...
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50,AL2:AS50")

autosave keeps saving as "true" or "false" for filename

something is wrong with the macro, it keeps saving the way i want it to, but names the file "true" or "false". Note: the cell value itself is "=today()"
Sub Macro1()
'
' Macro1 Macro
ActiveWorkbook.SaveAs Filename = Range("C6").Value
FileFormat = xlOpenXMLWorkbookMacroEnabled
CreateBackup = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
Filename = Range("c6").Value
FileFormat = pdf
Quality = xlQualityStandard
IncludeDocProperties = True
IgnorePrintAreas = False
OpenAfterPublish = False
End Sub
Try Filename:=Range("c6").Text to get the date as it appears in the cell.
The operator syntax is := between argument name and argument value.
Sub Macro1()
ActiveWorkbook.SaveAs _
Filename:=Range("C6").Text, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Range("c6").Text, _
FileFormat:=xlpdf, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub

Compile Error: Sub or Function not defined... Why?

So this is my code that´s is supposed to loop through the pivot's SUPPLIER FILTER based on a list located in the same worksheet. After every loop it has to upload the file to the intranet in a .pdf format.
Sub Upload()
Dim pt As PivotTable
Dim pi As PivotItem
Dim pf As PivotField
Dim lLoop As Long
Set pt = Sheets("To Supplier").PivotTables("PivotTable1")
Set pf = pt.PivotFields("[Query].[SUPPLIER].[SUPPLIER]")
Sheets("To Supplier").Select
For Each pi In pf.PivotItems
On Error Resume Next
pf.CurrentPage = pi.Value
On Error GoTo 0
If pf.CurrentPage = pi.Value Then
If lLoop = 0 Then
With Sheets("To Supplier").PageSetup
.CenterFooter = pi.Value
.LeftHeader = pt.Name
.LeftFooter = Now
End With
End If
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(RC[-6]:R[59]C[-5],MATCH(R[1]C[-10],RC[-6]:R[59]C[-6],0),2)"
Sheets("To Supplier").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"http://collaborationx.com/portalone/sourcing/Supplier%20documents/" & Cell("L2").Value _
& "/Evaluations/" & Cell("L2").Value & "%20Credits.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
lLoop = lLoop + 1
End If
Next pi
End Sub
However, It keeps throwing me off... now the prob is that it says the function is not defined, before the problem was with the references...
Cell("L2") is not defined. You probably wanted Range("L2") but since you selected that range before you could use ActiveCell. Example, HTH.
Option Explicit
Sub test()
Range("L2").Select
ActiveCell.FormulaR1C1 = "=INDEX(RC[-6]:R[59]C[-5],MATCH(R[1]C[-10],RC[-6]:R[59]C[-6],0),2)"
Dim exportFileName As String
exportFileName = "http://collaborationx.com/portalone/sourcing/Supplier%20documents/{0}/Evaluations/{0}%20Credits.pdf"
exportFileName = Replace(exportFileName, "{0}", ActiveCell.Value)
Sheets("To Supplier").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=exportFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub

Resources