fout in VBA code

Status
Niet open voor verdere reacties.

koster1984

Gebruiker
Lid geworden
4 jul 2012
Berichten
337
Ik heb een bestand met onderstaande code:


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
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan