Excel 2010 VBA, Keuzes van radio-buttons toevoegen aan String/Array

tijmen_4real · 12 feb 2018

Hoi,

Voor de keuze om een formulier te e-mail naar bepaalde ontvangers heb ik het volgende gemaakt:

Men kan dan bij de eventuele ontvanger aangeven of deze algemeen (Aan

, in de cc, bcc of niet een e-mail ontvangt.

Nu zitten de radio-buttons al per naam in een groep, bijvoormeeld EmailNadine, EmailMilo, etc.
Maar nu wil ik de keuze voor een button laten toevoegen aan een string, zodat bijv. in één keer bekend is op de regel aan:/cc:/bcc komt.
Hoe kan ik deze radio-buttons clusteren? Welke opdracht is hier goed geschikt voor?

Alle hulp is welkom! Bij voorbaat dank!!
Groet,

Tijmen

edmoor · 12 feb 2018

Gebruik een globale Dim of een Static String.
Meer weten?
Plaats een document in plaats van een plaatje.

tijmen_4real · 12 feb 2018

Natuurlijk wil ik meer weten

Het bestandje: Bekijk bijlage form.xlsm

edmoor · 12 feb 2018

Altijd handig, zo'n document met een onbekend wachtwoord op het VBA project.

tijmen_4real · 12 feb 2018

!#$&*!, Dat is stom van me.... Excuus!
Zonder wachtwoord: Bekijk bijlage form.xlsm

tijmen_4real · 12 feb 2018

Vol verwachting wacht ik nog op uw hulp...

edmoor · 12 feb 2018

Je kan deze functie in een Module plaatsen"

Code:

Function GroepWaarde(Groepnaam As String) As String
    Dim objX As Object
    
    With ActiveSheet
        For Each objX In .OLEObjects
            If TypeName(objX.Object) = "OptionButton" Then
                If objX.Object.GroupName = Groepnaam And objX.Object Then
                    GroepWaarde = objX.Object.Caption
                    Exit Function
                End If
            End If
        Next
    End With
End Function

Aanroep voorbeeld:

Code:

Mailtype = GroepWaarde("emailNadine")

Je krijgt dan het opschrift terug van de OptionButton met een True waarde uit de opgegeven groep.

edmoor · 12 feb 2018

tijmen_4real zei:
Vol verwachting wacht ik nog op uw hulp...

Busy, busy, busy...

tijmen_4real · 12 feb 2018

Ok, dat is een mooi stukje code (even output getest met MsgBox), maar moet hem nog converteren naar Aa:/CC:/BCC of geen ontvanger.
Daarna de ontvanger koppelen aan een emailadres (van bijv. Nadine).

Ik zal dus in het gedeelte van de e-mail een functie moeten aanroepen die uitleest of de option-button van een sectie (aan/cc/bcc) geselecteerd is.
Met jouw code zie ik hier geen toepassing voor, maar ben dan ook geen expert...

edmoor · 12 feb 2018

Je krijgt de juiste waarde per gebruiker terug. Wat je er verder mee doet is een andere vraag uiteraard.
Tevens staan er geen email adressen in het document waar het aan gekoppeld kan worden.

edmoor · 12 feb 2018

Even gekeken wat je verder doet in dat document. Je kan naast die andere functie bijvoorbeeld deze invoegen:

Code:

Function EmailSectie(AdresType) As String
    If GroepWaarde("emailNadine") = AdresType Then EmailSectie = EmailSectie & "nadine@bedrijf.nl" & ";"
    If GroepWaarde("emailEsther") = AdresType Then EmailSectie = EmailSectie & "esther@bedrijf.nl" & ";"
    If GroepWaarde("emailJack") = AdresType Then EmailSectie = EmailSectie & "jack@bedrijf.nl" & ";"
    If GroepWaarde("emailMilo") = AdresType Then EmailSectie = EmailSectie & "milo@bedrijf.nl" & ";"
    If GroepWaarde("emailLeendert") = AdresType Then EmailSectie = EmailSectie & "leendert@bedrijf.nl" & ";"
End Function

Het vullen van je variabele Email_To gaat dan zo:

Code:

Email_To = EmailSectie("Algemeen")

tijmen_4real · 13 feb 2018

Bedankt, man!

Bedoel je dat ik de tweede functie die je aangeeft direct onder de ander kan invoegen? Want dat geeft een foutmelding (1004).
Of moet deze in de e-mail sub?

Code:

Public ArtikelLinkAdres As String
Public BestandsNaam As String
Option Explicit


Sub create_and_email_pdf()
Rows("54:60").EntireRow.Hidden = True
Call DatumBestellingOpslaan
Call LeverancierBestellingOpslaan
Call DoelBestellingOpslaan
Call StatusBestellingOpslaan
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""
 
    EmailSubject = "Bestelling" & " " & Range("B4").Value & ", " & Range("B5").Value & ", " & Range("E5").Value
    OpenPDFAfterCreating = False
    AlwaysOverwritePDF = False
    DisplayEmail = True
    Email_To = EmailSectie("Algemeen")
    Email_CC = ""
    Email_BCC = ""
    'Prompt for file destination
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            DestFolder = .SelectedItems(1)
        Else
            MsgBox "Je moet eerst een map kiezen waar om het PDF-bestand in op te slaan" & vbCrLf & vbCrLf & "Klik op OK om af te sluiten", vbCritical, "Je moet een map kiezen om de PDF in op te slaan."
        Exit Sub
        End If
    End With
     
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & "Bestelling" & " " & Range("B4").Value & ", " & Range("B5").Value & ", " & Range("E5").Value & ".pdf"
    BestandsNaam = "(" & DestFolder & Application.PathSeparator & ")" & "Bestelling" & " " & Range("B4").Value & ", " & Range("B5").Value & ", " & Range("E5").Value & ".pdf"
 
    'If the PDF already exists
    If Len(Dir(PDFFile)) > 0 Then
            If AlwaysOverwritePDF = False Then
            OverwritePDF = MsgBox(PDFFile & " bestaat al." & vbCrLf & vbCrLf & "Wil je dit bestand overschrijven, Leen de Slijper?", vbYesNo + vbQuestion, "Bestand bestaat al")
            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, als je hem niet wilt overschrijven, komen we niet verder" _
                & vbCrLf & vbCrLf & "Klik op OK om af te sluiten.", vbCritical, "Macro beëindigen"
            Exit Sub
            End If
        Else
            On Error Resume Next
            Kill PDFFile
        End If
        If Err.Number <> 0 Then
            MsgBox "Het bestaande bestand kan niet worden verwijdered" _
            & vbCrLf & vbCrLf & "Klik OK om de macro te stoppen", vbCritical, "Verwijderen niet mogelijk"
        Exit Sub
        End If
    End If
    
    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating
 
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
         
    'Display email and specify To, Subject, etc
    With OutlookMail
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = "Groeten," & vbNewLine & "- Leendert"
        .Attachments.Add PDFFile
        If DisplayEmail = False Then
            .Send
        End If
    End With
Call BestandsnaamBestellingOpslaan
End Sub

Sub CommandButton23_Click()
    Call create_and_email_pdf
End Sub

'Formulier leegmaken
Sub CommandButton1_Click()
    Range("C7").Value = 1
    CommandButton3.Visible = False
    Rows("13:39").EntireRow.Hidden = True
    Range("B4").Value = ""
    Range("B5").Value = ""
    Range("E5").Value = ""
    Range("A10").Value = ""
    Range("D10").Value = ""
    Range("E10").Value = ""
    Range("A13").Value = ""
    Range("D13").Value = ""
    Range("E13").Value = ""
    Range("A16").Value = ""
    Range("D16").Value = ""
    Range("E16").Value = ""
    Range("A19").Value = ""
    Range("D19").Value = ""
    Range("E19").Value = ""
    Range("A22").Value = ""
    Range("D22").Value = ""
    Range("E22").Value = ""
    Range("A25").Value = ""
    Range("D25").Value = ""
    Range("E25").Value = ""
    Range("A28").Value = ""
    Range("D28").Value = ""
    Range("E28").Value = ""
    Range("A31").Value = ""
    Range("D31").Value = ""
    Range("E31").Value = ""
    Range("A34").Value = ""
    Range("D34").Value = ""
    Range("E34").Value = ""
    Range("A37").Value = ""
    Range("D37").Value = ""
    Range("E37").Value = ""
    Range("A41").Value = ""
End Sub

'Meer artikelen bestellen
Sub CommandButton4_Click()
    If Range("C7").Value = 9 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:39").EntireRow.Hidden = False
    CommandButton4.Visible = False
    ElseIf Range("C7").Value = 8 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:36").EntireRow.Hidden = False
    Rows("37:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 7 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:33").EntireRow.Hidden = False
    Rows("34:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 6 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:30").EntireRow.Hidden = False
    Rows("31:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 5 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:27").EntireRow.Hidden = False
    Rows("28:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 4 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:24").EntireRow.Hidden = False
    Rows("25:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 3 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:21").EntireRow.Hidden = False
    Rows("22:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 2 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:18").EntireRow.Hidden = False
    Rows("19:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 1 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:15").EntireRow.Hidden = False
    Rows("16:39").EntireRow.Hidden = True
    CommandButton3.Visible = True
    End If
End Sub
'Minder artikelen bestellen
Sub CommandButton3_Click()
    If Range("C7").Value = 2 Then
    CommandButton3.Visible = False
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:12").EntireRow.Hidden = False
    Rows("13:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 3 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:15").EntireRow.Hidden = False
    Rows("16:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 4 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:18").EntireRow.Hidden = False
    Rows("19:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 5 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:21").EntireRow.Hidden = False
    Rows("22:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 6 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:24").EntireRow.Hidden = False
    Rows("25:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 7 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:27").EntireRow.Hidden = False
    Rows("28:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 8 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:30").EntireRow.Hidden = False
    Rows("31:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 9 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:33").EntireRow.Hidden = False
    Rows("34:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 10 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:36").EntireRow.Hidden = False
    Rows("37:39").EntireRow.Hidden = True
    CommandButton4.Visible = True
    End If
End Sub

Sub DatumBestellingOpslaan()
Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("A:A").SpecialCells(4).Row
    Sheets("Overzicht bestellingen").Range("A" & lastrow).Value = Range("B4").Value
End Sub

Sub LeverancierBestellingOpslaan()
Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("B:B").SpecialCells(4).Row
    Sheets("Overzicht bestellingen").Range("B" & lastrow).Value = Range("B5").Value
End Sub

Sub DoelBestellingOpslaan()
Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("C:C").SpecialCells(4).Row
    Sheets("Overzicht bestellingen").Range("C" & lastrow).Value = Range("E5").Value
End Sub

Sub StatusBestellingOpslaan()
    Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("D:D").SpecialCells(4).Row
    Sheets("Overzicht bestellingen").Range("D" & lastrow).Value = "Formulier verwerkt"
End Sub

Sub BestandsnaamBestellingOpslaan()
    Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("E:E").SpecialCells(4).Row
    Sheets("Overzicht bestellingen").Range("E" & lastrow).Value = BestandsNaam
End Sub

Function GroepWaarde(Groepnaam As String) As String
    Dim objX As Object
    With ActiveSheet
        For Each objX In .OLEObjects
            If TypeName(objX.Object) = "OptionButton" Then
                If objX.Object.GroupName = Groepnaam And objX.Object Then
                    GroepWaarde = objX.Object.Caption
                    Exit Function
                End If
            End If
        Next
    End With
End Function

Function EmailSectie(AdresType) As String
    If GroepWaarde("emailNadine") = AdresType Then EmailSectie = EmailSectie & "nadine@bedrijf.nl" & ";"
    If GroepWaarde("emailEsther") = AdresType Then EmailSectie = EmailSectie & "esther@bedrijf.nl" & ";"
    If GroepWaarde("emailJack") = AdresType Then EmailSectie = EmailSectie & "jack@bedrijf.nl" & ";"
    If GroepWaarde("emailMilo") = AdresType Then EmailSectie = EmailSectie & "milo@bedrijf.nl" & ";"
    If GroepWaarde("emailLeendert") = AdresType Then EmailSectie = EmailSectie & "leendert@bedrijf.nl" & ";"
End Function

edmoor · 13 feb 2018

Zet functies altijd in een module.

tijmen_4real · 13 feb 2018

Je bedoelt in een (aparte)sub plaatsen en dan binnen de create_and_email_pdf sub aanroepen (call)?

edmoor · 13 feb 2018

Nee. Het zijn geen Subs, het zijn Functions en die plaats je in een Module.

tijmen_4real · 13 feb 2018

Ik begrijp je niet helemaal. Bedoel je dat ik deze in een klassemodule (in plaats van sheet) dien te plaatsen??

tijmen_4real · 13 feb 2018

Ik kom er zelf niet uit

Wil iemand mij alsjeblieft helpen?
Weet even niet hoe verder....

edmoor · 13 feb 2018

Plaatst je document zoals deze nu is.

tijmen_4real · 13 feb 2018

Ik heb het, via een omweg dan wel, aangepast.
Het werkt, hoewel de code niet zo mooi is, maar het is niet anders:

Code:

Public ArtikelLinkAdres As String
Public BestandsNaam As String
Public AanOntvangers As String
Public CCOntvangers As String
Public BCCOntvangers As String
Option Explicit

Sub DefinieerOntvangers()
    If OptionButton1 = True Then
        Range("H55").Value = "@;"
    ElseIf OptionButton2 = True Then
        Range("I55").Value = "@;"
    ElseIf OptionButton3 = True Then
        Range("J55").Value = "@;"
    End If
    If OptionButton5 = True Then
        Range("H56").Value = "@;"
    ElseIf OptionButton6 = True Then
        Range("I56").Value = "@;"
    ElseIf OptionButton7 = True Then
        Range("J56").Value = "@;"
    End If
    If OptionButton9 = True Then
        Range("H57").Value = "@;"
    ElseIf OptionButton10 = True Then
        Range("I57").Value = "@;"
    ElseIf OptionButton11 = True Then
        Range("J57").Value = "@;"
    End If
    If OptionButton13 = True Then
        Range("H58").Value = "@;"
    ElseIf OptionButton14 = True Then
        Range("I58").Value = "@;"
    ElseIf OptionButton15 = True Then
        Range("J58").Value = "@;"
    End If
    If OptionButton17 = True Then
        Range("H59").Value = "@;"
    ElseIf OptionButton18 = True Then
        Range("I59").Value = "@;"
    ElseIf OptionButton19 = True Then
        Range("J59").Value = "@;"
    End If
    AanOntvangers = Range("H55").Text & Range("H56").Text & Range("H57").Text & Range("H58").Text & Range("H59").Text
    CCOntvangers = Range("I55").Text & Range("I56").Text & Range("I57").Text & Range("I58").Text & Range("I59").Text
    BCCOntvangers = Range("J55").Text & Range("J56").Text & Range("J57").Text & Range("J58").Text & Range("J59").Text
End Sub

Sub create_and_email_pdf()
Call DatumBestellingOpslaan
Call LeverancierBestellingOpslaan
Call DoelBestellingOpslaan
Call StatusBestellingOpslaan
Call DefinieerOntvangers
OptionButton1.Visible = False
OptionButton2.Visible = False
OptionButton3.Visible = False
OptionButton4.Visible = False
OptionButton5.Visible = False
OptionButton6.Visible = False
OptionButton7.Visible = False
OptionButton8.Visible = False
OptionButton9.Visible = False
OptionButton10.Visible = False
OptionButton11.Visible = False
OptionButton12.Visible = False
OptionButton13.Visible = False
OptionButton14.Visible = False
OptionButton15.Visible = False
OptionButton16.Visible = False
OptionButton17.Visible = False
OptionButton18.Visible = False
OptionButton19.Visible = False
OptionButton20.Visible = False
Rows("54:61").EntireRow.Hidden = True
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""
 
    EmailSubject = "Bestelling" & " " & Range("B4").Value & ", " & Range("B5").Value & ", " & Range("E5").Value
    OpenPDFAfterCreating = False
    AlwaysOverwritePDF = False
    DisplayEmail = True
    Email_To = AanOntvangers
    Email_CC = CCOntvangers
    Email_BCC = BCCOntvangers
    'Prompt for file destination
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            DestFolder = .SelectedItems(1)
        Else
            MsgBox "Je moet eerst een map kiezen waar om het PDF-bestand in op te slaan" & vbCrLf & vbCrLf & "Klik op OK om af te sluiten", vbCritical, "Je moet een map kiezen om de PDF in op te slaan."
        Exit Sub
        End If
    End With
     
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & "Bestelling" & " " & Range("B4").Value & ", " & Range("B5").Value & ", " & Range("E5").Value & ".pdf"
    BestandsNaam = "(" & DestFolder & Application.PathSeparator & ")" & "Bestelling" & " " & Range("B4").Value & ", " & Range("B5").Value & ", " & Range("E5").Value & ".pdf"
 
    'If the PDF already exists
    If Len(Dir(PDFFile)) > 0 Then
            If AlwaysOverwritePDF = False Then
            OverwritePDF = MsgBox(PDFFile & " bestaat al." & vbCrLf & vbCrLf & "Wil je dit bestand overschrijven, Leen de Slijper?", vbYesNo + vbQuestion, "Bestand bestaat al")
            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, als je hem niet wilt overschrijven, komen we niet verder" _
                & vbCrLf & vbCrLf & "Klik op OK om af te sluiten.", vbCritical, "Macro beëindigen"
            Exit Sub
            End If
        Else
            On Error Resume Next
            Kill PDFFile
        End If
        If Err.Number <> 0 Then
            MsgBox "Het bestaande bestand kan niet worden verwijdered" _
            & vbCrLf & vbCrLf & "Klik OK om de macro te stoppen", vbCritical, "Verwijderen niet mogelijk"
        Exit Sub
        End If
    End If
    
    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating
 
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
         
    'Display email and specify To, Subject, etc
    With OutlookMail
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = "Groeten," & vbNewLine & "- Leendert"
        .Attachments.Add PDFFile
        If DisplayEmail = False Then
            .Send
        End If
    End With
Call BestandsnaamBestellingOpslaan
Rows("54:61").EntireRow.Hidden = False
OptionButton1.Visible = True
OptionButton2.Visible = True
OptionButton3.Visible = True
OptionButton4.Visible = True
OptionButton5.Visible = True
OptionButton6.Visible = True
OptionButton7.Visible = True
OptionButton8.Visible = True
OptionButton9.Visible = True
OptionButton10.Visible = True
OptionButton11.Visible = True
OptionButton12.Visible = True
OptionButton13.Visible = True
OptionButton14.Visible = True
OptionButton15.Visible = True
OptionButton16.Visible = True
OptionButton17.Visible = True
OptionButton18.Visible = True
OptionButton19.Visible = True
OptionButton20.Visible = True
End Sub

Sub CommandButton23_Click()
    Call create_and_email_pdf
End Sub

'Formulier leegmaken
Sub CommandButton1_Click()
    Range("C7").Value = 1
    CommandButton3.Visible = False
    Rows("13:39").EntireRow.Hidden = True
    Range("B4").Value = ""
    Range("B5").Value = ""
    Range("E5").Value = ""
    Range("A10").Value = ""
    Range("D10").Value = ""
    Range("E10").Value = ""
    Range("A13").Value = ""
    Range("D13").Value = ""
    Range("E13").Value = ""
    Range("A16").Value = ""
    Range("D16").Value = ""
    Range("E16").Value = ""
    Range("A19").Value = ""
    Range("D19").Value = ""
    Range("E19").Value = ""
    Range("A22").Value = ""
    Range("D22").Value = ""
    Range("E22").Value = ""
    Range("A25").Value = ""
    Range("D25").Value = ""
    Range("E25").Value = ""
    Range("A28").Value = ""
    Range("D28").Value = ""
    Range("E28").Value = ""
    Range("A31").Value = ""
    Range("D31").Value = ""
    Range("E31").Value = ""
    Range("A34").Value = ""
    Range("D34").Value = ""
    Range("E34").Value = ""
    Range("A37").Value = ""
    Range("D37").Value = ""
    Range("E37").Value = ""
    Range("A41").Value = ""
    OptionButton4 = True
    OptionButton8 = True
    OptionButton12 = True
    OptionButton16 = True
    OptionButton20 = True
End Sub

'Meer artikelen bestellen
Sub CommandButton4_Click()
    If Range("C7").Value = 9 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:39").EntireRow.Hidden = False
    CommandButton4.Visible = False
    ElseIf Range("C7").Value = 8 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:36").EntireRow.Hidden = False
    Rows("37:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 7 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:33").EntireRow.Hidden = False
    Rows("34:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 6 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:30").EntireRow.Hidden = False
    Rows("31:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 5 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:27").EntireRow.Hidden = False
    Rows("28:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 4 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:24").EntireRow.Hidden = False
    Rows("25:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 3 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:21").EntireRow.Hidden = False
    Rows("22:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 2 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:18").EntireRow.Hidden = False
    Rows("19:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 1 Then
    Range("C7").Value = Range("C7").Value + 1
    Rows("10:15").EntireRow.Hidden = False
    Rows("16:39").EntireRow.Hidden = True
    CommandButton3.Visible = True
    End If
End Sub
'Minder artikelen bestellen
Sub CommandButton3_Click()
    If Range("C7").Value = 2 Then
    CommandButton3.Visible = False
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:12").EntireRow.Hidden = False
    Rows("13:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 3 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:15").EntireRow.Hidden = False
    Rows("16:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 4 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:18").EntireRow.Hidden = False
    Rows("19:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 5 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:21").EntireRow.Hidden = False
    Rows("22:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 6 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:24").EntireRow.Hidden = False
    Rows("25:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 7 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:27").EntireRow.Hidden = False
    Rows("28:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 8 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:30").EntireRow.Hidden = False
    Rows("31:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 9 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:33").EntireRow.Hidden = False
    Rows("34:39").EntireRow.Hidden = True
    ElseIf Range("C7").Value = 10 Then
    Range("C7").Value = Range("C7").Value - 1
    Rows("10:36").EntireRow.Hidden = False
    Rows("37:39").EntireRow.Hidden = True
    CommandButton4.Visible = True
    End If
End Sub

Sub DatumBestellingOpslaan()
Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("A:A").SpecialCells(5).Row
    Sheets("Overzicht bestellingen").Range("A" & lastrow).Value = Range("B4").Value
End Sub

Sub LeverancierBestellingOpslaan()
Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("B:B").SpecialCells(5).Row
    Sheets("Overzicht bestellingen").Range("B" & lastrow).Value = Range("B5").Value
End Sub

Sub DoelBestellingOpslaan()
Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("C:C").SpecialCells(5).Row
    Sheets("Overzicht bestellingen").Range("C" & lastrow).Value = Range("E5").Value
End Sub

Sub StatusBestellingOpslaan()
    Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("D:D").SpecialCells(5).Row
    Sheets("Overzicht bestellingen").Range("D" & lastrow).Value = "Formulier verwerkt"
End Sub

Sub BestandsnaamBestellingOpslaan()
    Dim R As Range, lastrow As Long
lastrow = Sheets("Overzicht bestellingen").Range("E:E").SpecialCells(5).Row
    Sheets("Overzicht bestellingen").Range("E" & lastrow).Value = BestandsNaam
End Sub

edmoor · 13 feb 2018

Ik denk dat je je beter kan verdiepen in het gebruik van functies.

Excel 2010 VBA, Keuzes van radio-buttons toevoegen aan String/Array

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Gebruiker

Inventaris

Inventaris

Gebruiker

Inventaris

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Wij waarderen jouw privacy