Openen nieuw tabblad (gemaakt in VBA) geeft elke keer een andere bug in sheet

Status
Niet open voor verdere reacties.
M

Myrthe92

Gebruiker
Lid geworden
8 apr 2017
Berichten
94
Hallo allemaal,

Jullie hebben mij destijds enorm geholpen met het bouwen van een messagebox in VBA.
Bijgevoegd is het bestand Bekijk bijlage Format - Hartrevalidatie incl. hartfalen (definitief incl. grafiek) TWEEDE.xlsb waar het om gaat (let op vertrouwelijke informatie).
Bij het tabblad "Start" druk ik op "Invulschema hartrevalidatie standaard". Dan krijg ik de messagebox, deze vul ik in en ontstaat er een nieuw tabblad voor een nieuwe patiënt "Patiënt 1". Nu komt er weer een nieuwe patiënt "Patiënt 2" en klik ik weer in het tabblad "Start" op "Invulschema hartrevalidatie standaard". Wederom vul ik alle gegevens in, maar waarbij het vorige tabblad geen fouten in de sheet vertoond doet dat het nu wel. Heel vreemd want het basisschema waaruit deze is opgebouwd vertoond deze fouten niet. Soms kan ik 3 patiënten aanmaken zonder bugs en soms gaat het bij de tweede al mis. En elke keer is er een bug op een andere plek (bv. in grafiek opbouw, typen in tekstvakken die opeens niet zijn samengevoegd, het niet aannemen van de juiste kleuren bij een te lage waarde). Het lijkt alsof er continu een foute kopie wordt gemaakt vanuit het basisschema terwijl het basisschema klopt als ik deze test.

Heeft iemand van jullie een idee hoe deze fout voorkomen kan worden?

Het basisschema "Invulschema HR standaard" is een verborgen tabblad. De bladbeveiliging kan worden opgeheven met het wachtwoord "hart".
Stel dat bovenstaande fout op te lossen is, dan wil ik dit ook graag realiseren voor het "Invulschema hartfalen".

Ik hoop dat jullie mij kunnen helpen, want op deze manier is het niet bruikbaar in de dagelijkse praktijk.
Alvast bedankt.

Myrthe
 
Wanneer code zich onregelmatig werkt, plaats ik meestal op sommige plaatsen een "doevents".
Hierdoor krijgt excel netjes de tijd om zijn eigen taken af te werken, waarna de code verder loopt.
Plaats deze na het zetten/verwijderen van een wachtwoord, het aanmaken/verwijderen van een tabblad, het kopieeren van veel cellen.
 
Haal svp je bijlage weg als er vertrouwelijke informatie in staat.
Maak die informatie eerst onleesbaar/zinloos voordat je het bestand opnieuw uploadt.
 
@snb
medische data en geboortedatum zijn realistisch.
naam, email, telefoon is fictief
 
Beste alphamax,

Bedankt voor uw reactie.
Ik heb de bijgevoegde handleiding bestudeerd. Ik ben alleen een enorme dummie op dit gebied.
Waar in VBA moet ik dit dan verwerken?
 
zie rode tekst

in blad6/start
Code: 
Dim pwd As String
Private Sub CommandButton1_Click()
pwd = "hart" 'verander hier uw paswoord
Sheets("Invulschema HR standaard").Visible = True
Sheets("Invulschema HR standaard").Unprotect Password:=pwd
Sheets("Invulschema HR standaard").Activate
[COLOR="#FF0000"]DoEvents[/COLOR]
End Sub
Private Sub CommandButton2_Click()
pwd = "hart" 'verander hier uw paswoord
Sheets("Invulschema hartfalen").Visible = True
Sheets("Invulschema hartfalen").Unprotect Password:=pwd
Sheets("Invulschema hartfalen").Activate
[COLOR="#FF0000"]DoEvents[/COLOR]
End Sub
in frmgegevens
Code: 
Private Sub CommandButton1_Click()
pwd = "hart" 'verander hier uw paswoord
For Each ct In Controls
  Select Case TypeName(ct)
    Case "ComboBox"
      If ct.ListIndex = -1 Then
       MsgBox ct.Tag & " is niet ingevuld!", vbCritical, "Fout!"
       ct.SetFocus
       Exit Sub
      End If
    Case "TextBox"
      If LCase(Right(ct.Tag, 5)) = "datum" Then
        If Not IsDate(ct) Then
          MsgBox ct.Tag & " is geen geldige datum!", vbCritical, "Fout!"
          ct.SetFocus
          Exit Sub
        End If
       Else
        If Len(Trim(ct)) = 0 Then
          MsgBox ct.Tag & " is niet ingevuld!", vbCritical, "Fout!"
          ct.SetFocus
          Exit Sub
        End If
      End If
   End Select
Next ct
If MsgBox("Correcte ingave?", vbYesNo + vbQuestion, "Controleer de gegevens!") = vbNo Then Exit Sub
ActiveSheet.Range("K6").Resize(11) = Application.Transpose(Array(Format(TextBox1, "dddd dd mmmm yyyy"), Format(CDate(TextBox1) + 42, _
"dddd dd mmmm yyyy"), "=count(A5:A311)", TextBox2.Text, TextBox3.Text, Format(CDate(TextBox4.Value), "dd-mm-yyyy"), "=DATEDIF(K11,TODAY(),""y"")", _
ComboBox1.Text, TextBox5.Value, TextBox6.Value, ComboBox2.Text))
If CheckBox1.Value = True And ActiveSheet.Name = "Invulschema HR standaard" Or ActiveSheet.Name = "Invulschema hartfalen" Then
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
[COLOR="#FF0000"]DoEvents[/COLOR]
For Each WS In Worksheets
    WS.Protect Password:=pwd
Next WS
[COLOR="#FF0000"]DoEvents[/COLOR]
NewPageName = [K10] & " (" & [K9] & ")"
ActiveWindow.ActiveSheet.Name = NewPageName
Unload Me
Else
Unload Me
End If
End Sub

Private Sub CommandButton2_Click()
pwd = "hart" 'verander hier uw paswoord
If MsgBox("U heeft op [Sluiten] gedrukt, indien u op [Ja] drukt wordt het nieuwe invulschema volledig afgesloten." & vbCrLf & vbCrLf & _
"Indien u op [Nee] drukt kunt u verder werken, maar bent u verplicht het formulier volledig in te vullen en nadien op [Gegevens invullen] te drukken. De gegevens worden dan opgeslagen." & vbCrLf & vbCrLf & _
"Sluiten?", _
vbYesNo + vbQuestion, "Sluiten?") = vbNo Then Exit Sub
Sheets("Start").Activate
Unload Me
Sheets("Invulschema HR standaard").Protect Password:=pwd
Sheets("Invulschema HR standaard").Visible = False
Sheets("Invulschema hartfalen").Protect Password:=pwd
Sheets("Invulschema hartfalen").Visible = False
Application.DisplayAlerts = False
[COLOR="#FF0000"]DoEvents[/COLOR]
'Application.Quit
End Sub
 
Laatst bewerkt:
Beste alphamax,

Hartstikke bedankt voor uw reactie en voorbeeld! Ik heb bovenstaande toegepast, dus als het goed is moeten er geen bugs meer in zitten.

Met vriendelijke groet,

Myrthe
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan