Aanpassen van een aangeleverd code door derde

[masala09]

Ik heb deze code teruggekregen van een maat van mij die de code dermate als niet werkend heeft aangepast voor zijn eigen werk.

Ik kom er even niet meer uit. Ik snap niet wat hij gedaan heeft.

Wat ik weet is dat zodra hij 1 van de options heeft aangeklikt er een invoerschermpje verschijnt waar dan direct de focus op moet worden gezet voor invoer. Voor iedere option heeft hij een andere code. Het spreekt volgens mij wel uit de rest van de code wat er dan moet gebeuren.

De wachtwoorden heeft hij op een ander blad geplaatst.

Ik heb het kunnen aanpassen tot onderstaand, maar krijg het niet meer voor elkaar. Ik zie iets over het hoofd.

Kunnen jullie helpen?

Private Sub UserForm_Initialize()

    Caption = "Autorisatiecode vereist"
    BackColor = &HC0E0FF 'Kleur Roze
    lb_Pogingen.Caption = vbNewLine & " Selecteer hieronder tot welk onderdeel u toegang wilt hebben" & vbNewLine & vbNewLine & " en klik na invoeren van bijbehorend wachtwoord op OK."
    lb_Pogingen.BackColor = &HC0FFFF 'Kleur Geel
    cb_OK.BackColor = &HC0C0C0 'Kleur Donkergrijs
    cb_Annuleren.BackColor = &HC0C0C0 'Kleur Donkergrijs
    OptionButton1.BackColor = &HC0E0FF 'Kleur Roze
    OptionButton2.BackColor = &HC0E0FF 'Kleur Roze
    CheckBox1.Visible = False
    tb_Wachtwoord.Visible = False
    
End Sub

Private Sub OptionButton1_Click()
    tb_Wachtwoord.Visible = True
    Call cb_OK_Click
    
End Sub

Private Sub OptionButton2_Click()
    tb_Wachtwoord.Visible = True
    Call cb_OK_Click
    
End Sub

Private Sub cb_OK_Click()
    Select Case OptionButton1.Value
    Case Is = True
        Select Case tb_Wachtwoord
        Case Is = Sheets("Instellingen").Range("C5")
            Unload Me
            Frm_005.Show
        Case Else
            GoTo Vervolg
        End Select
            
    Case Is = False
        Select Case tb_Wachtwoord
        Case Is = Sheets("Instellingen").Range("C6")
            Unload Me
            Sheets("Lijsten").Select
            Exit Sub
        Case Else
            GoTo Vervolg
        End Select
    End Select
    
Vervolg:
            MsgBox "Verkeerde code." & vbNewLine & vbNewLine & "Klik OK en probeer opnieuw.", vbInformation, "Autorisatiecode"
            tb_Wachtwoord.Value = vbNullString
            tb_Wachtwoord.SetFocus
    
End Sub

Private Sub cb_Annuleren_Click()
    Unload Me
    Exit Sub
    
End Sub

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

Net even goed aangepast tot waar ik ben gekomen.
Ik ben nog niet helemaal bekend met optionbuttons.

 

[masala09]

Een stukje verder werkend gekregen, maar nu pas ik echt. Ik ga nu fouten maken.

Private Sub cb_OK_Click()
    With OptionButton1.Value = True
    
        Select Case tb_Wachtwoord
        Case Is = Sheets("Instellingen").Range("C5")
            Unload Me
            Frm_005.Show
        Case Else
            GoTo Vervolg
        End Select
    Exit Sub
    End With
    
    With OptionButton2.Value = True
    
        Select Case tb_Wachtwoord
        Case Is = Sheets("Instellingen").Range("C6")
            Unload Me
            Sheets("Lijsten").Select
            Exit Sub
        Case Else
            GoTo Vervolg
        End Select
    Exit Sub
    End With

Vervolg:
            MsgBox "Verkeerde code." & vbNewLine & vbNewLine & "Klik OK en probeer opnieuw.", vbInformation, "Autorisatiecode"
            tb_Wachtwoord.Value = vbNullString
            tb_Wachtwoord.SetFocus
    
    'Case Is = False
        'MsgBox "U heeft geen keuze geselecteerd." & vbNewLine & vbNewLine & "Selecteer a.u.b. uw keuze.", vbInformation, ""

End Sub

De onderste regel voor End Sub zou er ook nog in verwerkt moeten worden als dat kan.

 

[masala09]

Oke ik heb af en toe een hekel aan mijzelf. Ik blijf kennelijk doorgaan en voor mijn gevoel klopt de boel. In ieder geval onderstaande code heb ik dus wel werkend gekregen. Echter ik vraag toch om jullie controle of aanvullingen dan wel aanpassingen. Het kan ongetwijfeld korter.

Toch ben ik wel blij met mijn doorzettingsvermogen.

Private Sub UserForm_Initialize()

    Caption = "Autorisatiecode vereist"
    BackColor = &HC0E0FF 'Kleur Roze
    lb_Pogingen.Caption = vbNewLine & " Selecteer hieronder tot welk onderdeel u toegang wilt hebben" & vbNewLine & vbNewLine & " en klik na invoeren van bijbehorend wachtwoord op OK."
    lb_Pogingen.BackColor = &HC0FFFF 'Kleur Geel
    cb_OK.BackColor = &HC0C0C0 'Kleur Donkergrijs
    cb_Annuleren.BackColor = &HC0C0C0 'Kleur Donkergrijs
    OptionButton1.BackColor = &HC0E0FF 'Kleur Roze
    OptionButton2.BackColor = &HC0E0FF 'Kleur Roze
    CheckBox1.Visible = False
    tb_Wachtwoord.Visible = False
    
End Sub

Private Sub OptionButton1_Click()

    With tb_Wachtwoord
        .Visible = True
        .SetFocus
    End With
    
End Sub

Private Sub OptionButton2_Click()

    With tb_Wachtwoord
        .Visible = True
        .SetFocus
    End With
    
End Sub

Private Sub cb_OK_Click()

    With OptionButton1
        Select Case OptionButton1.Value
        Case Is = True
            Select Case tb_Wachtwoord
            Case Is = Sheets("Instellingen").Range("C5")
                Unload Me
                Frm_005.Show
                Exit Sub
            Case Else
                GoTo Code
            End Select
        Case Is = False
            GoTo OptionButton2
        End Select
    
    End With
    
OptionButton2:

    With OptionButton2
        Select Case OptionButton2.Value
        Case Is = True
            Select Case tb_Wachtwoord
            Case Is = Sheets("Instellingen").Range("C6")
                Unload Me
                Sheets("Instellingen").Select
                Exit Sub
            Case Else
                GoTo Code
            End Select
        Case Is = False
            MsgBox "U heeft geen keuze geselecteerd." & vbNewLine & vbNewLine & "Selecteer a.u.b. uw keuze.", vbInformation, ""
        End Select
        
    Exit Sub
    End With

Code:
            MsgBox "Verkeerde code." & vbNewLine & vbNewLine & "Klik OK en probeer opnieuw.", vbInformation, "Autorisatiecode"
            tb_Wachtwoord.Value = vbNullString
            tb_Wachtwoord.SetFocus
            
End Sub

Private Sub cb_Annuleren_Click()
    Unload Me
    Exit Sub
    
End Sub

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

Aandachtspuntje voor mijzelf vind ik nog wel steeds het opzetten van de code. Nu ik deze hier zo plaats, wordt de code erg rommelig en onoverzichtelijk. Als men hier een oplossing voor heeft dan houd ik mij aanbevolen. En ja ik weet het jullie willen altijd een opzetje, maar is dat met dit soort zaken dan ook echt noodzakelijk?

 

[snb]

de hele Initialize code is overbodig als je bij het ontwerp deze eigenschappen instelt.

de controlecode in de vervolgknop is overbodig als je dit gebruikt:

Private sub tb_wachtwoord_change()
   cb_OK.visible=tb_wachtwoord.text=Sheets("Instellingen").Range("C5")
end sub

 

[masala09]

Avond SNB,

Klopt die Initialize code wil ik inderdaad ook voor hem via de instellingen regelen. Had ik verder nog niet naar gekeken. Hij heeft toentertijd van mij deze code gekregen die ik zelf direct uit een pakket van Warm Bakkertje had gepakt. Deze had ik zelf met oefenen een beetje aangepast om te kijken hoe het allemaal een beetje werkte en eigenlijk zo doorgespeeld aan hem. Ik heb dit al voor mijzelf al aangepast alleen hij nog niet.

Dat laatste van jou snap ik eerlijk gezegd even niet. Ik ging ervan uit dat dit te maken had net het wijzigen van een code. Dit ivm de "change" functie.
Wat doet dit dan precies? Ik bedoel doet deze dan zodra de code niet waar is ook het veld ook leeg maken en de cursor weer terug in het veld zetten. Dat wat ik nu met tb_Wachtwoord = vbNullString en tb_Wachtwoord.SetFocus? Als dat zo is dan mis ik voor mijn gevoel weer het stukje msgbox en de rest...

Of ik moet nu even te zwaar kijken.

Trouwens... er zijn toch meerdere vergelijkingen die deze moet maken.... dit omdat er 2 opties staan met ieder een eigen wachtwoord.

 

[snb]

Waarom al die moeite ?

draai eens deze code:

sub M_snb()
  msgbox environ("username")
end sub

of

sub M_snb()
  msgbox environ("computername")
end sub

Daarmee kun je toch in het bestand zetten, zonder dat enig wachtwoord ingvoerd hoeft te worden:
Stel dat environ("username") 'masala09" is,

Private Sub Workbook_open()
  if environ("Username")<> "masala09" then thisworkbook.close false
End Sub

Alleen de gebruiker met de juiste 'username' kan dan het bestand openen als macro's ingeschakeld zijn.

 

[masala09]

Avond SNB.

Sorry dat ik zo laat reageer. Ik zag je reactie net pas.

Ik zal deze code zeker in mijn hoofd houden. Dit bespaart veel invoer en inderdaad wachtwoorden. Helaas is het met deze code wel zo dat er veel aangepast moet worden.

De eventcode voor wachtwoord change begrijp ik niet helemaal. Ik zal dat eens verder bekijken. Wellicht dat je een link hebt.

Mvg Maarten