• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Opgelost Macro aanpaasen voor controle invullen verplichte cellen

Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.

wimix69

Gebruiker
Lid geworden
19 mrt 2011
Berichten
223
Hallo,

Ik heb een order formulier gemaakt met daar in een macro die controleert als er wordt opgeslagen en het tabblad zichtbaar is of alle verplichte cellen zijn ingevuld, zo niet dan komt er een fout melding. Nu wil ik ook dat als er een combinatie twee of meerdere van de volgende tabbladen zichtbaar is er een foutmelding komt als Cel C105 niet is in gevuld. Het gaat om tabbladen, Loepbril, Telescoopbril, DrogeOgenBril & Ptosisbril. In heb de Macro in een leeg Excel formulier geplaatst
 

Bijlagen

En jij dacht dat wij wel even al die werkbladen gingen zitten aanmaken, het bestand gingen opslaan om vervolgens met 249 foutmeldingen om de oren te worden geslagen?
Verder zou ik nog eens goed kijken naar deze combinaties, lijken me niet erg logisch:
Code:
            CheckLoepbril = LegeCel("AJ214", "Loepbril")
            CheckLoepbril = LegeCel("X36", "ErgraLowVisionZorgMenu")
of            
            CheckPtosisbril = LegeCel("M207", "Ptosisbril")
            CheckPtosisbril = LegeCel("D32", "ErgraLowVisionZorgMenu")
En het telkens weer herhalen van de With / End With constructie terwijl je in hetzelfde werkblad blijft is ook niet nodig.
En schepen liggen voor de rede, maar een reden moet je motiveren.
En het voltooid deelwoord van bedoelen is bedoeld.
Ik stop nu maar even.
 
Is het nu de bedoeling dat we zelf die tabbladen aanmaken om te kunnen controleren?
Of heb je zelf nog geen tabbladen?
Anders heb ik hier een leeg bestand gezet waar je ze kan bijvoegen.
 

Bijlagen

en... mogen we ook weten hoe je het opgelost hebt?
anders heb je hier een voorbeeldje.
 

Bijlagen

Nee is nog niet opgelost,

Maar ik moet geloof ik nog beter formuleren

De Macro werkt goed zonder fout medingen in het bestand dat ik gebruik met daar in de bedoelde tabbladen. Er hoeft dus niets te worden aangemaakt of gemaakt door jullie. Alleen wil ik in deze macro een extra controle maken.

Het tabblad ErgraLowVisionZorgMenu is alleen zichtbaar, hier in worden gegevens ingevoerd. In cel H14 worden zorgverzekeraars in gevuld. en keuzes gemaakt om andere tabbladen zichtbaar te maken. Afhankelijk van de zorgverzekeraar moet dan een motivatie geschreven worden Als er een combinatie twee of meerdere van de volgende tabbladen zichtbaar is Loepbril, Telescoopbril, DrogeOgenBril & Ptosisbril. Als er geen motivatie geschreven is in Cel C105 van deze tabbladen dan moet er een foutmelding komen dat dit nog gedaan moet worden.

Ik hoop dat het zo duidelijk is en dat jullie hier mee iets kunnen.
 
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet
    Dim countVisible As Integer
    Dim insurerCell As Range
    Dim insurerList As Variant
    Dim i As Integer
    Dim j As Integer

    ' Lijst van relevante tabbladnamen
    Dim sheetNames As Variant
    sheetNames = Array("BiOptic", "loepbril", "Beeldschermloep", "Luisterboek", "Computer", "VoorleesScanner", "Telescoopbril", "Ondertitels", "DrogeOgenBril", "Ptosisbril", "Kinderbril")

    ' Zorgverzekeraars die gecontroleerd moeten worden
    insurerList = Array("CZ", "Delta Lloyd", "Just", "Ohra", "Nationale nederlanden")

    ' Controleer of de verzekeraar in cel H14 van het ErgraLowVisionZorgMenu-tabblad zit
    Set insurerCell = Worksheets("ErgraLowVisionZorgMenu").Range("H14")
    
    ' Debug: Print de waarde van de verzekeraar in cel H14
    Debug.Print "Verzekeraar in H14: " & insurerCell.Value
    
    For i = LBound(insurerList) To UBound(insurerList)
        ' Debug: Print de verzekeraar uit de lijst die wordt gecontroleerd
        Debug.Print "Controleer verzekeraar: " & insurerList(i)
        
        If insurerCell.Value = insurerList(i) Then
            ' Tel het aantal zichtbare relevante tabbladen
            countVisible = 0
            For Each ws In ThisWorkbook.Worksheets
                If Not ws.Name = "ErgraLowVisionZorgMenu" Then
                    For j = LBound(sheetNames) To UBound(sheetNames)
                        If ws.Name = sheetNames(j) And ws.Visible = xlSheetVisible Then
                            countVisible = countVisible + 1
                        End If
                    Next j
                End If
            Next ws
            
            ' Debug: Print het aantal zichtbare relevante tabbladen
            Debug.Print "Aantal zichtbare relevante tabbladen: " & countVisible
            
            ' Als er meer dan één zichtbaar is, toon de foutmelding
            If countVisible > 1 Then
                MsgBox "Maak bij ieder voorschrift een motivatie waarom meerdere hulpmiddel noodzakelijk zijn", vbCritical
                Cancel = True
                Exit Sub
            End If
            Exit For
        End If
    Next i
End Sub
 
Plaats dan een relevant voorbeeld, nu is het zoals een blinde slaat naar een ei.
 
"Er hoeft dus niets te worden aangemaakt of gemaakt door jullie." Is een grapje zeker.

Zoiets dan:
Code:
Sub Test()
    shts = Array("Loepbril", "Telescoopbril", "DrogeOgenBril", "LoePtosisbrilpbril")
    For i = 1 To 4
        If Sheets(shts(i)).Visible Then n = n + 1
    Next
    If n >= 2 Then
        For i = 1 To 4
            With Sheets(shts(i))
                If .Visible And .Range("C105") = vbNullString Then
                    MsgBox "Motivatie ontbreekt op werkblad " & shts(i), vbCritical, "Motivatie niet opgegeven."
                End If
            End With
        Next
    End If
End Sub
En kijk toch eens naar bericht #2
 
@AHulpje ,
uw oplossing staat al in #4 is niet voldoende maar TS zegt er niet bij wat ontbreekt hij plaatst enkel een code die niet kan werken.
 
Het is nu opgelost, Ik heb de macro's in een module geplaats, en de onderstaande macro in ThisWorkbook

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ' Roep de verschillende controle subroutines aan
    Call CheckInvoerverplichtecellen(Cancel)
    ' Als Cancel al True is, hoef je de andere checks niet uit te voeren
    If Cancel Then Exit Sub
    
    Call CheckInsurance(Cancel)
    Call CheckManiervanuitleveren(Cancel)
    ' Voeg hier meer calls toe naar andere subroutines indien nodig
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan