• 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.

inhoud van één van drie tabbladen moet volledig ingevuld zijn.

Status
Niet open voor verdere reacties.
stefano

stefano

Gebruiker
Lid geworden
22 mei 2004
Berichten
860
Beste,

ik heb een bestand met drie sheets Nederlands, Français en English waarin gegevens dienen aangevuld te worden. Afhankelijk van de taal van de gebruiker dient slechts één tabblad ingevuld te worden.

Bijkomende voorwaarde:

Alle cellen ( in geel gekleurd, zie bestand in bijlage) moeten ingevuld zijn. Dan pas kan/mag het bestand opgeslagen worden. Dus wanneer alle cellen van tabblad frans ingevuld werden dan mag er opgeslagen worden.

Wanneer niks ingevuld werd in de drie tabbladen dan mag het bestand ook kunnen opgeslagen worden natuurlijk.

Ik probeerde via onderstaande code maar heb er ondertussen een knoeiboeltje van gemaakt.

Kan iemand me helpen ?

Dank,

Stefano

Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

With Sheets("Nederlands")
 
  If IsEmpty(.Range("B2").Value) And IsEmpty(.Range("B3").Value) Then
    GoTo Frans
  ElseIf Not IsEmpty(.Range("B2").Value) And Not IsEmpty(.Range("B3").Value) Then
    GoTo Frans
  Else
    Cancel = True
    MsgBox "Vul aub alle codes in op tabblad Nederlands. "
  End If
End With

Frans:

With Sheets("Français")
  If IsEmpty(.Range("B2").Value) And IsEmpty(.Range("B3").Value) Then
    GoTo Engels
  ElseIf Not IsEmpty(.Range("B2").Value) And Not IsEmpty(.Range("B3").Value) Then
    GoTo Engels
  Else
    Cancel = True
    MsgBox "Vul aub alle codes in op tabblad Français. "
  End If
End With

Engels:

With Sheets("English")
  If IsEmpty(.Range("B2").Value) And IsEmpty(.Range("B3").Value) Then
    Exit Sub
    ElseIf Not IsEmpty(.Range("B2").Value) And Not IsEmpty(.Range("B3").Value) Then
    Exit Sub
  Else
    Cancel = True
    MsgBox "Vul aub alle codes in op tabblad English. "
  End If
End With

End Sub

Bekijk bijlage Mel A.xlsm
 
Test deze eens:
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For sh = 1 To Sheets.Count
 With Sheets(sh)
   If IsEmpty(.Range("B2").Value) OR IsEmpty(.Range("B3").Value) Then
    MsgBox "Vul aub alle codes in op tabblad " & Sheets(sh).Name: Exit Sub
   End If
 End With
Next

End Sub
 
@ cobbe, uw code zal werken volgens mij:thumb:
@ stefano, Et pour les Flamands la même chose:D
Met andere woorden, Vul aub alle codes in op tabblad huppeldepup
Het blauwe stukje code mag altijd in het Nederlands:shocked:
 
Volgens mij werk de code niet geheel correct. Cancel zal nog even op True gezet moeten worden.

Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For Each sh In Sheets
  If Application.CountA(sh.Range("B2:B3")) <> 2 Then
    MsgBox sh.Name & " is niet compleet"
    Cancel = True
    Exit Sub
  End If
Next sh
End Sub
 
Beste,

alvast dank voor de hulp maar:

1. Wanneer ik de code in het bestand plak dan kan ik het bestand niet opslaan wanneer geen enkele cel is ingevuld ( de totaal blanco versie zonder data )
2. Wanneer ik bij tab Nederlands de cellen B2 en B3 invul dan krijg ik de vraag om het tabblad français ook in te vullen. Het is de bedoeling dat 1 tabblad volledig ingevuld is terwijl de andere twee nog blanco mogen zijn. Dus of Nederlands volledig ingevuld of Français volledig ingevuld of Engels volledig ingevuld.

(3.) @gast0660 : Het blauwe stukje code mag altijd in het Nederlands , ik snap niet over welke code het gaat. sorry.
 
Laat een tellertje meelopen.
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Worksheet, y As Long
For Each sh In Worksheets
      If Application.CountA(sh.Range("b2:b3")) = 2 Then
         Exit Sub
      Else
        y = y + IIf(Application.CountA(sh.Range("b2:b3")) = 0, 0, 1)
      End If
 Next sh
   If y > 0 Then
        MsgBox "Vul minimaal in een tabblad alle codes in"
        Cancel = True
   End If
End Sub
 
De code trekt nergens op maar doet wel wat gevraagd is, denk ik zo:
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For i = 1 To 3
 With Sheets(i)
  If IsEmpty(.Range("b2")) + IsEmpty(.Range("B3")) <> -2 Then taal = Sheets(i).Name: GoTo invullen
  teller = teller + IsEmpty(.Range("b2")) + IsEmpty(.Range("B3"))
 End With
Next
If teller = -6 Then GoTo opslaan
invullen:
  If IsEmpty(Sheets(i).Range("b2")) + IsEmpty(Sheets(i).Range("B3")) = True Then
    Sheets(i).Activate
    MsgBox "Vul aub alle codes in op tabblad " & taal: Cancel = True: Exit Sub
  End If
opslaan:
End Sub
 
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error Resume Next
    
    For Each it In Sheets
       If Range("B2:B3").SpecialCells(4).Count = 1 Then
          If Err.Number = 0 Then
             MsgBox "completeer B2:B3 in " & it.Name
             Cancel = True
             Exit Sub
          End If
       End If
     Next
End Sub
 
@snb : de code werkt, waarvoor dank. Wanneer ik echter op het tabblad "Français" slechts 1 cel invul en dan save dan verschijnt de melding 'completeer B2:B3 in Nederlands" terwijl Nederlands eigenlijk Français moet zijn. Blijkbaar luistert de code niet naar de 'it.Name'.

Code: 
MsgBox "completeer B2:B3 in " & it.Name
 
Als it.name wordt weergegeven weet je natuurlijk waar dat voor staat. Luisteren is geen ingebouwde VBA-funktionaliteit ;)
Als je de code begrijpt kun je hem zelf eenvoudig aanpassen.
 
Als je de code begrijpt kun je hem zelf eenvoudig aanpassen.

Neen, dat doe ik dus niet :(, net zoals ik ook niet begrijp waarom de code niet werkt als ik de range uitbreid van "B2:B3" naar "B2:B3" , "B5:B6".

Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error Resume Next
    
    For Each it In Sheets
       If Range("B2:B3", "B5:B6").SpecialCells(4).Count = 1 Then
          If Err.Number = 0 Then
             MsgBox "Gelieve alle cellen  in te vullen "
             Cancel = True
             Exit Sub
          End If
       End If
     Next
End Sub
 
Kan iemand helpen aub ?

SpecialCells(4) staat voor het aantal lege cellen

Maar waarom werkt de code niet als je de rangen uitbreidt van "B2:B3" naar "B2:B3" , "B5:B6".
 
Als je iemand negeert kan je moeilijk nog iets verwachten.
Als mijn code niet werkt had ik dat wel graag geweten.
 
@stefano, zoals je het nu geschreven hebt wordt de linker bovenhoek en rechter onderhoek aangewezen van het te selecteren gebied kortom excel ziet alleen B2 en B6 en zal alle tussenliggende cellen testen. als je losse 2 bereiken wil aanwijzen moet je maar 1x aanhalingstekens gebruiken

pas de code aan naar
Code: 
 Range("B2:[COLOR="#0000CD"]B3, B5[/COLOR]:B6")
dan zou het wel moeten werken.
 
@ Cobbe, sorry, ik negeer hier niemand maar probeer een code ook te begrijpen, hetgeen absoluut niet makkelijk is. Ik wil je wel zeggen dat ik die van jou niet als eerste uitgeprobeerd heb omdat je zelf schreef ' de code trekt nergens op maar ..."

Ik zit bv al enkel dagen te zoeken op de betekenis van

Code: 
 y = y + IIf(Application.CountA(sh.Range("B1:B3, C10:C30")) = 0, 0, 1)

en ik vind geen antwoord.

Dus ja voor mij is het niet echt makkelijk, maar nogmaals, ik negeer niemand, excuus !
 
Code: 
y = y + IIf(Application.CountA(sh.Range("B1:B3, C10:C30")) = 0, 0, 1)

Y heeft de waarde 0, dan worden de cellen B1:B3 gecontroleerd op inhoud.
Als die cellen leeg zijn behoudt y de waarde 0 anders het aantal ingevulde cellen.

Die Y telt dan weer als voorwaarde voor dit:
Code: 
 If y > 0 Then
        MsgBox "Vul minimaal in een tabblad alle codes in"
        Cancel = True
   End If
 
Je moet het zien als:
Y=y+als(aantalarg(b1:b2)=0,dan 0,anders 1)
 
ik krijg het niet voor elkaar vandaar dat ik dan maar even het volledige bestand post.

Gebieden B1:B3, C8(= vervolgkeuzelijst), c10:c26, c28:c30 moeten allen ingevuld zijn op één tabblad. Dan mag opslaan toegestaan worden, zoniet dient de messagebox te verschijnen.

dank voor alle hulp,

Stefano

PS: de code is onvolledig ( ranges etc ... )

Bekijk bijlage NS 3 talen.xlsm
 
Wil je eens testen?

Als het werkt zal er wel iemand de code fatsoeneren.:)
 

Bijlagen

  • NS 3 talen(cobbe).xlsm
    27,6 KB · Weergaven: 27
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan