koster1984
Gebruiker
- Lid geworden
- 4 jul 2012
- Berichten
- 337
Ik heb een bestand met onderstaande code:
Het werkt helemaal goed, op één ding na. Als ik op CommandButton4 druk worden de geselecteerde tabbladen geprint, maar om de een of andere wordt in diezelfde tabbladen het bereik I3:L4 geselecteerd. Bij CommandButton3 doet ie dat niet en ik zie niet aan welk stukje code dat zou moeten liggen. Kan iemand me helpen?
Gr,
Daniel
Code:
Private Sub CommandButton5_Click()
For Each it In Sheets(Array("CompuTrain", "Twice", "Broekhuis"))
I = 5
Do
If it.Range("AB" & I) <= Date Then
I = I + 1
End If
Loop Until it.Range("AB" & I) > Date
With it
.PageSetup.PrintArea = "$B$6:$AA$" & I - 1
End With
Next
For Each it In Sheets(Array("Budgettering"))
I = 3
Do
If it.Range("B" & I) <= Date Then
I = I + 1
End If
Loop Until it.Range("B" & I) > Date
With it
.PageSetup.PrintArea = "$C$4:$O$" & I - 1
End With
Next
For Each it In Sheets(Array("0VERZICHT"))
I = 3
Do
If it.Range("X" & I) <= Date Then
I = I + 1
End If
Loop Until it.Range("X" & I) > Date
With it
.PageSetup.PrintArea = "$C$4:$X$" & I - 1
End With
Next
For Each it In Sheets(Array("ZOEK"))
I = 5
Do
If it.Range("Y" & I) <= Date Then
I = I + 1
End If
Loop Until it.Range("Y" & I) > Date
With it
.PageSetup.PrintArea = "$E$6:$X$" & I - 1
End With
Next
For Each it In Sheets(Array("Werkbestand"))
I = 8
Do
If it.Range("AR" & I) <= Date Then
I = I + 1
End If
Loop Until it.Range("AR" & I) > Date
With it
.PageSetup.PrintArea = "$I$9:$AR$" & I - 1
End With
Next
End Sub
Private Sub Label1_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim sSheet
Dim I As Integer
For Each sSheet In Sheets
ListBox1.AddItem sSheet.Name
Next sSheet
'ListBox1.Selected(0) = True
End Sub
Private Sub CheckBox1_Click()
'ListBox1.Selected(0) = True
ListBox1.Selected(0) = CheckBox1.Value
ListBox1.Selected(1) = CheckBox1.Value
ListBox1.Selected(2) = CheckBox1.Value
ListBox1.Selected(3) = CheckBox1.Value
ListBox1.Selected(5) = CheckBox1.Value
ListBox1.Selected(6) = CheckBox1.Value
ListBox1.Selected(7) = CheckBox1.Value
End Sub
Private Sub CheckBox2_Click()
'ListBox1.Selected(0) = True
ListBox1.Selected(5) = CheckBox2.Value
ListBox1.Selected(6) = CheckBox2.Value
ListBox1.Selected(7) = CheckBox2.Value
End Sub
Private Sub CheckBox3_Click()
Dim iloop As Integer
For iloop = 1 To ListBox1.ListCount
ListBox1.Selected(iloop - 1) = CheckBox3.Value
Next
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Dim I As Integer
'ListBox1.Selected(0) = True '<----- This automatically selects the first sheet
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) Then j = j + 1
Next I
If j = 0 Then MsgBox " niks geselecteerd": Exit Sub
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) = True Then
Sheets(ListBox1.List(I, 0)).PrintOut
End If
Next
Sheets("Werkbestand").Select
'Unload Me
End Sub
Private Sub CommandButton3_Click()
Dim I As Integer
Dim ftst As Variant
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) Then j = j + 1
Next I
If j = 0 Then MsgBox " Niks geselecteerd": Exit Sub
'ListBox1.Selected(0) = True '<----- This automatically selects the first sheet
ftst = Sheets("Werkbestand").Range("A1").Value '<----- Folder in Cell G1 (Ex C:\My Documents\)
ftso = Sheets("Werkbestand").Range("B1").Value
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) = True Then
Sheets(ListBox1.List(I, 0)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ftst & "\" & ftso & " - " & ListBox1.List(I, 0), Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'False
End If
Next
Sheets("Werkbestand").Select
'Unload Me
End Sub
Private Sub CommandButton4_Click()
Dim I As Long, X As Long
Dim vntFilePath As Variant
Dim arrValues()
Dim strDesktop As String, strBestand As String
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) Then j = j + 1
Next I
If j = 0 Then MsgBox " Niks geselecteerd": Exit Sub
'ListBox1.Selected(0) = True '<----- This automatically selects the first sheet
strBestand = ""
'strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") '<----- Saves to Desktop
ftso = Sheets("Werkbestand").Range("B1").Value
strDesktop = "R:\Facturatie\Brochures\_Bugettering\Printouts"
If ListBox1.ListIndex <> -1 Then
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) Then
ReDim Preserve arrValues(X)
arrValues(X) = ListBox1.List(I)
X = X + 1
End If
Next I
End If
Sheets(arrValues).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDesktop & "\" & strBestand & ftso, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Sheets("Werkbestand").Select
'Unload Me
End Sub
'Private Sub CommandButton5_Click() 'Warme bakkertje
'Dim Ctl As Control, sName As String, sArray()
'ReDim sArray(0)
'For Each Ctl In Me.Controls
' If TypeOf Ctl Is MSForms.CheckBox Then
' If Ctl Then
' sName = Replace(Ctl.Caption, " ", "")
' sArray(UBound(sArray)) = sName
' ReDim Preserve sArray(UBound(sArray) + 1)
' End If
' End If
' Next
' ReDim Preserve sArray(UBound(sArray) - 1)
'Sheets(sArray).Select
'ActiveSheet.ExportAsFixedFormat Type:=0, Filename:="D:\Test.PDF"
'Sheets("Start").Select
'End Sub
Het werkt helemaal goed, op één ding na. Als ik op CommandButton4 druk worden de geselecteerde tabbladen geprint, maar om de een of andere wordt in diezelfde tabbladen het bereik I3:L4 geselecteerd. Bij CommandButton3 doet ie dat niet en ik zie niet aan welk stukje code dat zou moeten liggen. Kan iemand me helpen?
Gr,
Daniel