I have the following code that exports the selected range in the worksheet as .pdf file:
'More coding above
With Sheet7
If (CheckBox1.Value = True And CheckBox2.Value = True) Then
.PageSetup.PrintArea = "A8:M80"
ElseIf (CheckBox1.Value = True And CheckBox2.Value = False) Then
.PageSetup.PrintArea = "A8:M55"
ElseIf (CheckBox1.Value = False And CheckBox2.Value = True) Then
.PageSetup.PrintArea = "A8:M32, A56:M80"
Else
MsgBox 'At least one option must be selected!'
Exit Sub
End If
End With
'More coding below
However, when only CheckBox2 is checked, the file is generated selecting only the areas as set by If/Else, but still showing the A33:M55 gap between ranges.
Is there anyway I could suppress this gap? I want the code to print both ranges as if they were one.
I tried the Union method, but it gives me the same result.
Any help will be greatly appreciated!
The simplest way is to hide unnecesarry rows if it's possible for a moment before print to PDF. In this way you should make sure after macro all rows are visible (additional you can use On Error GoTo and unhide just in case)
Related
I have the code below, im trying to make my selection of cells print on one a4 page rather than spread across 6 in a command button that is on a sheet, can anyone point out what im doing wrong? I expected to be able to have a printing window like with saving a sheet or something like that, but this is all i can find. thanks a tonne for your help :)
Private Sub CommandButton3_Click()
Sheets("Home").PageSetup.PrintArea = "$A$1:$W$44"
Sheets("Home").PageSetup.Orientation = xlLandscape
Sheets("Home").PageSetup.FitToPagesWide = 1
Sheets("Home").PageSetup.FitToPagesTall = 1
Sheets("Home").PrintPreview (EnableChanges = True)
'Sheets("Home").PrintOut (Preview = True)
End Sub
Ive looked for other some VBA online and looked up the pagesetup, but i cant seem to find what im after, the code above is the closest ive found, but it makes no difference to the printing process.
Is this what you are trying? I have commented the relevant parts of the code. Let me know if you still have any questions.
Option Explicit
Sub Sample()
With ThisWorkbook.Sheets("Home")
With .PageSetup
.PrintArea = "$A$1:$W$44"
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'~~> To fit text spanning in different pages change the view
ActiveWindow.View = xlPageBreakPreview
'~~> Extend the Horizontal Pagebreak to extreme right
'~~> This mimics what you do when you are dragging the PgBrk
If .HPageBreaks.Count > 0 Then _
.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
'~~> Similarly extend the Vertical Pagebreak to extreme down
If .VPageBreaks.Count > 0 Then _
.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
.PrintPreview EnableChanges:=True
'~~> Change the view back to normal
ActiveWindow.View = xlNormalView
End With
End Sub
BEFORE
and the print preview
AFTER
I have 2 sheets on excel, one called Raw and one called Graphs. What I want to do is have some cells in Raw and it they =TRUE then I want a shape to appear on the Graphs page.
I am pretty new to VBA so i havent tried much :(
Private Sub Worksheet_Calculate()
With Worksheets("Graph")
If Me.Range("FK45").Value = True Then
.Shapes("Test1").Visible = True
Exit Sub
ElseIf Me.Range("FK45").Value = False Then
.Shapes("Test1").Visible = False
Exit Sub
End If
End With
End Sub
I can get this to work so if FK45 is TRUE the image shows but if FK45 is FALSE it doesn't, But what I want to be able to do is add more to this e.g.
Private Sub Worksheet_Calculate()
With Worksheets("Graph")
If Me.Range("FK45").Value = True Then
.Shapes("Test1").Visible = True
Exit Sub
ElseIf Me.Range("FK45").Value = False Then
.Shapes("Test1").Visible = False
Exit Sub
End If
End With
With Worksheets("Graph")
If Me.Range("FK46").Value = True Then
.Shapes("Test2").Visible = True
Exit Sub
ElseIf Me.Range("FK46").Value = False Then
.Shapes("Test2").Visible = False
Exit Sub
End If
End With
End Sub
I want them all to be independent from each other and be able to add more if necessary
If FK45 is TRUE Image1 shows
If FK45 is FALSE Image1 doesn't show
and/or
If FK46 is TRUE Image2 shows
If FK46 is FALSE Image2 doesn't show
and/or
If FK47 is TRUE Image3 shows
If FK47 is FALSE Image3 doesn't show
and so on...
This is how I would do it
In VB Editor find your Worksheet and Shape objects and rename their system name to something intutive in their respective property windows.
This way you can get rid of With Worksheets("Graph") construction, instead you can call them by their system name like With Graph. This will also come in handy if you wish to rename your worksheets or shapes.
Note that you Exit Sub after each cell check, your procedure stops after first cell and doesn't proceed any further.
Instead of Worksheet.Calculate event I advise using Worksheet.Change. This way you can iterate through your cells one by one.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Range
Dim shpImage As Shape
For Each rngCell In Target.Cells
' check if change was made in "FK"
If Not Intersect(rngCell, Me.Columns("FK")) Is Nothing Then
Select Case rngCell.Row
Case 45: Set shpImage = Graph.MyImage_1
Case 46: Set shpImage = Graph.MyImage_2
End Select
' if only boolean values present, no need for IF construction
shpImage.Visible = rngCell.Value : Set shpImage = Nothing
End If
Next
End Sub
If you had separate column for image name it would be much easier, you could check like this (for example, shape names are located in "FL" column)
Graph.Shapes(rngCell.Offset(0, 1).Value).Visible = rngCell.Value
This is my first program in VBA.
I have an excel sheet which contains multiple questions and each question has a check box to make it editable or read only.
Here below an example
How many cars you own?
How many free coupon you have?
So introducing two check boxes, using that I can make them read only or editable.
So I have tried a vba code to do the same(by Googling). Here below is the code snippet.
Private Sub CheckBox13_Click()
If Sheet3.CheckBox13.Value = False Then
Sheet3.Range("B20:CZ20").Interior.ColorIndex = 16
Range("B20:CZ20").Locked = True
ActiveSheet.Protect Contents:=True
Else
ActiveSheet.Protect Contents:=False
Range("B20:CZ20").Locked = False
Sheet3.Range("B20:CZ20").Interior.ColorIndex = 0
End If
End Sub
Private Sub CheckBox14_Click() 'eigth question Hide check box code
If Sheet3.CheckBox14.Value = False Then
Sheet3.Range("B21:CZ21").Interior.ColorIndex = 16
Range("B21:CZ21").Locked = True
ActiveSheet.Protect Contents:=True
Else
ActiveSheet.Protect Contents:=False
Range("B21:CZ21").Locked = False
Sheet3.Range("B21:CZ21").Interior.ColorIndex = 0
End If
End Sub
My problem is:
Default both rows are editable and both check boxes unchecked
Now I check the first check box, so first row color changed and
became read only.
Now I check the second check box. Getting an error.
error 1004, Application defined or object defined error.
Let me know if I missed out any basic information in order to understand the problem.
Since we don't know where the problem happen, I would try this :
Private Sub CheckBox13_Click()
If Sheet3.CheckBox13.Value = False Then
Sheet3.Protect Contents:=False
Sheet3.Range("B21:CZ21").Locked = False
Sheet3.Range("B20:CZ20").Interior.ColorIndex = 16
Sheet3.Range("B20:CZ20").Locked = True
Sheet3.Protect Contents:=True
Else
Sheet3.Protect Contents:=False
Sheet3.Range("B20:CZ20").Locked = False
Sheet3.Range("B20:CZ20").Interior.ColorIndex = 0
End If
End Sub
Private Sub CheckBox14_Click()
If Sheet3.CheckBox14.Value = False Then
Sheet3.Protect Contents:=False
Sheet3.Range("B21:CZ21").Locked = False
Sheet3.Range("B21:CZ21").Interior.ColorIndex = 16
Sheet3.Range("B21:CZ21").Locked = True
Sheet3.Protect Contents:=True
Else
Sheet3.Protect Contents:=False
Sheet3.Range("B21:CZ21").Locked = False
Sheet3.Range("B21:CZ21").Interior.ColorIndex = 0
End If
End Sub
Details :
I've added Sheet3 before your ranges, (and replaced ActiveSheet by Sheet3) to be sur you're not modifying another Sheet.
I've added ActiveSheet.Protect Contents:=False - Sheet3.Range("B21:CZ21").Locked = False before modifying Range colors to be sure that the Range is not protected.
I'm working on a userform that allows the end user to filter first by individual business units, then select the "flags" (0, 1, 2) they want to see. The combobox that lists the various business units works fine, it's the "flags" I'm having an issue with.
The users need to be able to select more than one flag to analyze. I orignally thought that using Checkboxes would be the way to go, however I can't seem to get the code to perform as I expect it to. If one checkbox is selected, it works fine, but if more than one is selected, it only filters by the value of the first checkbox selected.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Masterlist").Activate
Range("I1").Select
ActiveSheet.Range("I1").AutoFilter Field:=9, Criteria1:=ComboBox1
With ActiveSheet
If CheckBox1.Value = True Then
ActiveSheet.Range("BL1").AutoFilter Field:=64, Criteria1:="0"
ElseIf CheckBox2.Value = True Then
ActiveSheet.Range("BL1").AutoFilter Field:=64, Criteria1:="1"
ElseIf CheckBox3.Value = True Then
ActiveSheet.Range("BL1").AutoFilter Field:=64, Criteria1:="2"
End If
End With
Application.ScreenUpdating = True
End Sub
Is there a better choice? Or can the code I already have be modified to work?
I am using a worksheet change function to give my excel spread sheet the illusion of a search bar with a drop down box containing the results of the text in the search bar.
before I just had the hide rows part of my code which would hide and then unhide some rows in my spread sheet containing the results. that worked fine but the results would sometimes be slow and not always show up until I re calculated them.
so I added calculate to the ranges and this unfortunately slows the whole thing down substantially. Is there a better way to do this?
Private Sub Worksheet_Change(ByVal target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Range("D11").Value <> "" Then
Dim xlpassword As String
xlpassword = "Perry2012"
ActiveSheet.Unprotect xlpassword
ActiveSheet.EnableCalculation = False
ActiveSheet.EnableCalculation = True
Worksheets("HOME").Range("A1").Calculate
Worksheets("HOME").Range("D33").Calculate
Worksheets("HOME").Range("D32").Calculate
Worksheets("HOME").Range("E33").Calculate
Worksheets("HOME").Range("E32").Calculate
Worksheets("HOME").Range("F33").Calculate
Worksheets("HOME").Range("F32").Calculate
Worksheets("HOME").Range("G33").Calculate
Worksheets("HOME").Range("G32").Calculate
Worksheets("HOME").Range("H33").Calculate
Worksheets("HOME").Range("H32").Calculate
Worksheets("HOME").Range("I33").Calculate
Worksheets("HOME").Range("I32").Calculate
Worksheets("HOME").Range("J33").Calculate
Worksheets("HOME").Range("J32").Calculate
Worksheets("HOME").Range("K33").Calculate
Worksheets("HOME").Range("K32").Calculate
Worksheets("HOME").Range("L33").Calculate
Worksheets("HOME").Range("L32").Calculate
Worksheets("HOME").Range("M33").Calculate
Worksheets("HOME").Range("M32").Calculate
Worksheets("HOME").Range("N33").Calculate
Worksheets("HOME").Range("N32").Calculate
Worksheets("HOME").Range("O33").Calculate
Worksheets("HOME").Range("O32").Calculate
Worksheets("HOME").Range("P33").Calculate
Worksheets("HOME").Range("P32").Calculate
Worksheets("HOME").Range("Q33").Calculate
Worksheets("HOME").Range("Q32").Calculate
Worksheets("HOME").Range("R33").Calculate
Worksheets("HOME").Range("R32").Calculate
Worksheets("HOME").Range("S33").Calculate
Worksheets("HOME").Range("S32").Calculate
Worksheets("HOME").Range("T33").Calculate
Worksheets("HOME").Range("T32").Calculate
Worksheets("HOME").Range("U33").Calculate
Worksheets("HOME").Range("U32").Calculate
Worksheets("HOME").Range("V33").Calculate
Worksheets("HOME").Range("V32").Calculate
Worksheets("HOME").Range("W33").Calculate
Worksheets("HOME").Range("W32").Calculate
Worksheets("HOME").Range("D15").Calculate
Worksheets("HOME").Range("D17").Calculate
Worksheets("HOME").Range("D19").Calculate
Worksheets("HOME").Range("D21").Calculate
Worksheets("HOME").Range("D23").Calculate
Worksheets("HOME").Range("D25").Calculate
Worksheets("HOME").Range("D27").Calculate
Worksheets("HOME").Range("M15").Calculate
Worksheets("HOME").Range("M17").Calculate
Worksheets("HOME").Range("M19").Calculate
Worksheets("HOME").Range("M21").Calculate
Worksheets("HOME").Range("M23").Calculate
Worksheets("HOME").Range("M25").Calculate
Worksheets("HOME").Range("M27").Calculate
Worksheets("HOME").Range("T15").Calculate
Worksheets("HOME").Range("T17").Calculate
Worksheets("HOME").Range("T19").Calculate
Worksheets("HOME").Range("T21").Calculate
Worksheets("HOME").Range("T23").Calculate
Worksheets("HOME").Range("T25").Calculate
Worksheets("HOME").Range("T27").Calculate
Rows("15:28").Hidden = False
Rows("34:36").Hidden = True
Else
Rows("15:28").Hidden = True
Rows("34:36").Hidden = False
ActiveSheet.Protect xlpassword
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Would replacing all those separate lines by just one work:
Application.Calculate
it might be the case that you have some volatile functions heavily used in the workbook(i.e. TODAY()), which I reckon will make all formulas based on them re-calculate on each of those calculation lines in your code