Keuze Ja en Nee in 1 sub samenvoegen

[masala09]

Onderstaand een code. Deze werkt, maar ik weet voor mijn gevoel zeker dat dit korter kan. Ik kom er alleen niet uit.

Het gaat om een formulier en daarbij de twee losse knoppen JA en NEE.

Private Sub Label1_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
    lb_Vraag.Caption = "Uw factuur is opgeslagen." & vbNewLine & vbNewLine & "Wilt u deze ook uitprinten?"
    
End Sub

Private Sub cb_Ja_Click()
    
    Unload frm_Printen
    Application.Dialogs(xlDialogPrint).Show
    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"

End Sub

Private Sub cb_Nee_Click()

    Unload frm_Printen
    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True

End Sub

 

[edmoor]

Ik zou het anders inrichten en het dan via een message box doen:

Private Sub PrintenJaNee()
    
    Select Case Msgbox ("Uw factuur is opgeslagen." & vbNewLine & vbNewLine & "Wilt u deze ook uitprinten?", vbYesNo)
	Case vbYes
	    Application.Dialogs(xlDialogPrint).Show
    End Select

    Unload frm_Printen
    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"
End Sub

Dan kan er een label en een knop weg.
Die lege routines kun je trouwens sowieso uit de code halen.

 

[masala09]

In jouw idee zou jij dus aanraden het hele formulier te verwijderen en er een msgbox van te maken.

Dan kom ik uit op onderstaande code:

Sub Factuur_Opslaan()
'Knop
    On Error Resume Next
    rMkDir "D:\Facturatie\Facturen PDF\" & Year(Date)
    Sheets("Factuur").ExportAsFixedFormat 0, "D:\Facturatie\Facturen PDF\" & Year(Date) & "\" & Sheets("factuur").Range("I13").Value & ".pdf"
    With Sheets("Factuur")
        Sheets("Database facturen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13) = Array(.Range("I13"), .Range("A3"), .Range("I12"), ['Factuur maken'!C40], _
          .Range("I11"), .Range("C52"), ['Factuur maken'!C36], .Range("H39"), .Range("H45"), .Range("H43"), .Range("B13"), .Range("B19"), .Range("B22"))
          
   End With
   
    Select Case MsgBox("Uw factuur is opgeslagen." & vbNewLine & vbNewLine & "Wilt u deze ook uitprinten?", vbYesNo)
    Case vbYes
        Application.Dialogs(xlDialogPrint).Show
    End Select

    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"
    
End Sub

 

[edmoor]

Zoiets dus inderdaad

 

[masala09]

De code werkt goed. Echter wat ik wel zie en dat vind ik wel jammer voor het zichtwerk. De knoppen Ja en Nee staan niet in het midden van de box. Persoonlijk vind ik dit netter. Is hier een mogelijkheid voor. Anders blijf ik liever met het formulier werken daar dit hier wel in het midden staat. Echter dan krijg ik een lange code. Nu weet ik niet of dat iets uitmaakt voor de verwerking.

Ook weet ik nu meteen hoe het werkt met die msgbox met meer velden. Ik zie dat je slechts 1 knop een opdracht geef. De andere krijgt automatisch een opdracht. Mocht ik meerdere knoppen willen dan moet ik een iedere knop, behalve de annuleer of nee, apart met case een opdracht geven.

Klopt het trouwens dat de muisaanwijzer buiten de box rondjes blijft draaien en dus wacht op reactie?

 

[masala09]

Zoiets???? Niet goed??

 

[edmoor]

Ik heb het niet getest, vandaar mijn "zoiets", maar het ziet er prima uit.
Als je persé met het formulier en de Ja en Nee knoppen wilt blijven werken zou je het ook zo kunnen doen:

Private Sub UserForm_Initialize()
    lb_Vraag.Caption = "Uw factuur is opgeslagen." & vbNewLine & vbNewLine & "Wilt u deze ook uitprinten?"
End Sub

Private Sub cb_Ja_Click()    
    frm_Printen.Visible = False
    Application.Dialogs(xlDialogPrint).Show
    Call cb_Nee_Click
End Sub

Private Sub cb_Nee_Click()
    Unload frm_Printen
    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"
End Sub

 

[masala09]

Perse is niet speciaal aan de orde, maar ik ben altijd eigenwijs met lay-out etc. Ik ben wat dat aangaat helaas perfectionistisch aangelegd.
Hierdoor duren persoonlijke projecten bij mij wel eens langer dan nodig. Tenzij ik bij een klant bezig ben. Dan ben ik wat makkelijker, maar wel netjes, goed en volgens de regels. Ten slot van rekening hoef ik mij aan zijn wil niet te ergeren. Het is zijn project en ik voer slechts uit.
Beide codes zijn goed en perfect, maar het zit hem net in de opzet van die msgbox. Ik vind dat persoonlijk niet netjes, maar ja wie ben ik tegenover MS.

 

[edmoor]

Ik snap wat je bedoeld, zo ben ik zelf ook wel een beetje
Het schermpje van de messagebox is van het type System en moet je dus eerst een keuze maken voordat je wat anders kunt doen, vandaar de draaiende cursor buiten de box.

Hier kun je trouwens alle mogelijkheden van de messagebox lezen:
http://msdn.microsoft.com/en-us/library/139z2azd(v=vs.80).aspx

 

[masala09]

Oke bedankt ik ga er eens mee experimenteren.

even snel een klein vraagje buiten dit topic om en dan gaat het slot erop.

De code

For i = 2 to Sheets.Count
Sheets(i).Visible = True

Wat doet deze code en wanneer gebruik je die. Het tweede gedeelte maakt de tabbladen zichtbaar, maar waar staat die "i" voor in het tweede gedeelte.

Ik vraag mij dit al even af en ik weet even niet zo snel deze vraag te plaatsen. Om hier nu een volledig apart topic van te maken, vind ik weer een beetje ver gaan.

 

[masala09]

Trouwens toch nog even een opmerking.

De tekst in jouw laatste code:" cb_Nee_Click(), wordt in het rood weergegeven. Gaat er ergens iets niet goed? Of klopt dit.

 

[edmoor]

Daarmee wordt aangegeven dat er iets fout is in de syntax.
Maar er maar dit van:
Call cb_Nee_Click

Over je andere vraag:
Die letter i in de For...Next loop is een tellertje.
Voorbeeld:
http://www.excel-vba-easy.com/vba-programming-excel-vba-loop.html

In je voorbeeld worden dus alle tabbladen vanaf blad 2 zichtbaar gemaakt.

 

[masala09]

Private Sub cb_Ja_Click()

    Unload frm_Printen
    Application.Dialogs(xlDialogPrint).Show
    
    Call cb_Nee_Click
    
End Sub

Private Sub cb_Nee_Click()

    Unload frm_Printen
    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"
    
End Sub

Edmoor goedenavond. Ik heb jouw code ingevoerd, maar zodra ik de knop ja aanklik, dan print de pagina wel, maar blijft vervolgens op de sheet staan. sub_Nee wordt aangeroepen, maar wordt niet afgehandeld.

Juiste volgorde van procedure is:

Knop Factuur opslaan= Gegevens verwerken naar de doelcellen en bestanden, Tonen formulier printen met daarin de keuze JA of NEE. Bij Ja zichtbaarheid formulier printen uit en zichtbaarheid print dialoog aan. Macro op pauze in afwachting van keuze van het printdialoog. Na de keuze JA of ANNULEREN dan verder met macro: Goto blad: "Factuur maken" en cellen wissen. Bij keuze NEE van formulier printen, zichtbaarheid formulier printen uit, Goto blad: "Factuur maken" en cellen wissen.

 

[edmoor]

Misschien dat 'ie mis gaat omdat het formulier al weg is.
Doet het dan eens zo:

Private Sub cb_Nee_Click()
    On Error Resume Next
    Unload frm_Printen
    On Error GoTo 0
    Application.Goto Sheets("Factuur maken").Range("D4")
    ThisWorkbook.Worksheets("Factuur maken").Unprotect "1235"
    Range("c12:h12,c28,c32,c36,c40,B43:E43").ClearContents
    ThisWorkbook.Worksheets("Factuur maken").Protect "1235"
End Sub

 

[masala09]

Nope zelfde probleem.

Anders moet ik gewoon mijn code houden zoals deze was. Alleen dan moet ik straks dan gaan kopieren voor de Clear.Contents en wordt de code voor mijn gevoel onnodig lang. Nu zal dat denk ik niet veel uitmaken voor de werking, maar er wordt wel eens gewaarschuwd voor te lange sub routines daar de boel dan behoorlijk vetraagd. Al geloof ik dit niet voor een kleine sub zoals die van mij. Er moeten iets van 60 cellen geleegd worden. Nu weet ik niet of de clear.Contents dat aan kan, maar dat is te proberen. Al die cellen moet ik nog gaan invoeren zodra de lay-out definitief is. Er is al behoorlijk wat mis gegaan en ik ben al door een domme beginnersfout, vergeten de nieuwe lay-out te saven waardoor ik hier al een verkeerde plaatste. Al het gedane werk voor sommigen hier was toen ineens voor niets en nu al helemaal omdat als je eenmaal gaat beginnen met het opnieuw opzetten er weer nieuwe ideeën bij komen. Vandaar dat ik eerst zeker wil zijn met mijn lay-out en alvast macro's zelf probeer te maken of aan te passen. Voor het wegschrijven naar een databestand heb ik sowieso straks wel echt jullie nodig. Dit ook omdat de databestanden hoogstwaarschijnlijk uit dit werkboek gaan en als los apart bestand worden opgeslagen en moeten kunnen worden benaderd.

Het wachtwoord gedeelte heb ik al aangepast. Ik vind het niet netjes, maar goed ruzie zal je er niet om krijgen. Temeer omdat een werkende aanvulling een optie voor een ander op dit forum kan zijn die hetzelfde wilt en kun je dus delen. Een oude code werkt men toch dikwijls bij naar eigen inzicht. Echter de basis blijft gelijk.

 

[masala09]

Ik heb mijn besluit genomen. Ik houd het op de oude manier. Is wel iets langer, maar het werkt.

Allemaal bedankt.