inhoud van keuzelijst op een werkblad gebruiken voor een code via userform

[rkootje]

Hallo,

wie kan me helpen, ik kom er niet uit.
ik heb een keuzelijst met invoervak op een werkblad gezet, waar ik de weken kan selecteren. op een bepaald moment heb ik een userform met oke knop, wanneer ik op oke druk, dienen de gegevens op blad 1 gekopieert te worden in een range die ik heb bepaald via naamvak (Week 1, Week2 enz.) bij de code wil ik dus verwijzen naar de week welke geselecteerd in in de keuzelijst op blad 1. maar ik krijg steeds foutmeldingen.
(Compileerfout) kan de methode of gegevenslid niet vinden. wat doe ik fout??

Private Sub cmbwwoke_Click()

If Txtww <> "Alfred" Then
MsgBox "Wachtwoord onjuist"
Else



    Range("B4:E4").Select
    ActiveCell.FormulaR1C1 = "Acc. AKL"
    Range("B4:E4").Select
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
End If
    Application.ScreenUpdating = False
        Application.Goto Reference:="copie"
    Selection.Copy
    Application.Goto Reference:=Me.Cbbkeuzeweek
    'ActiveSheet.Unprotect
    ActiveSheet.Paste
    Application.Goto Reference:="copie"
    Application.CutCopyMode = True
    'ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
   Range("A1").Select
   Application.ScreenUpdating = True

    Unload Me
    
End Sub

 

[Tilly1987]

Alleen meer vragen

Hallo rkootje,

Ik heb zo goed mogelijk de code proberen te begrijpen, maar ik denk dat het beeld niet geheel duidelijk is. Waar staat deze code? (Ik vermoed in de Userform, klopt dit?). Zo ja bestaat er een Cbbkeuzeweek op het Userform? Uit het verhaal begreep ik dat het via een combobox op blad1 werd ingevuld.

Weet je zeker dat alle range namen bestaan? (copie en de waarde van Cbbkeuzeweek)

Wellicht kan ik na opheldering van bovengenoemde punten meer van waarde zijn.

Met vriendelijke groet,

Tilly

PS
Enkele opmerkingen toegevoegd.

Private Sub cmbwwoke_Click()

If Txtww <> "Alfred" Then
    MsgBox "Wachtwoord onjuist"
Else
    Range("B4:E4").Select                   'Eerst een range selecteren hoeft niet.
    ActiveCell.FormulaR1C1 = "Acc. AKL"     'Dit kan bijvoorbeeld Range("B4:E4").FormulaR1C1 = "Acc. AKL"
    Range("B4:E4").Select                   'Zou dit weglaten en volgende regel veranderen
    With Selection.Interior                 'Zou dit veranderen in With Range("B4:E4").Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
End If

    Application.ScreenUpdating = False              'Wees voorzichtig met deze optie, als je geen error trapping hebt!!
        Application.Goto Reference:="copie"         'Bestaat de naam copie in range namen?
    Selection.Copy                                  'Range("copie").Copy ?
    Application.Goto Reference:=Me.Cbbkeuzeweek     'Bestaat Me.Cbbkeuzeweek? (Eventueel Range(Me.Cbbkeuzeweek).PasteSpecial)
    'ActiveSheet.Unprotect
    ActiveSheet.Paste                                                ' Is de bedoeling om de celwaarde van "copie" in de (bedoelde) cel van Cbbkeuzeweek te plakken? 
    Application.Goto Reference:="copie"
    Application.CutCopyMode = True
    'ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
   Range("A1").Select                               'Waarom hier een selectie? Kan denk ik weg?
   Application.ScreenUpdating = True                'Let erop dat dit altijd uitgevoerd wordt, mits het uitgezet is!

    Unload Me
    
End Sub

 

[rkootje]

Hoi Tilly1987

Ik had het e.e.a. al draaiende, maar heb wat problemen met beveiliging van het document. als de sheet al beveiligd is, krijg een een foutmelding, fout 1004, Methode paste van klasse is mislukt, dan wordt de regel geel van "ActiveSheet.Paste"
de aanpassing die je hebt voorgesteld heb ik inmiddels doorgevoerd, daar wordt de code wel beter leesbaar van.

om het e.e.a. beter te begrijpen, heb ik een voorbeeldje van het document toegevoegd.Bekijk bijlage Test urenregistratieemail1.zip

 

[Tilly1987]

Oorzaak van het kopieer probleem zijn merged cellen.

Hey rKootje,

Ik ben achter het probleem. Als je programmatisch iets wilt gaan kopieren en plakken, dan werken Merged Cellen niet mee. Excel gaat soms anders met de inhoud van merged cellen om dan wij op eerste indruk zouden verwachten. De kopieer actie mislukt omdat er merged cellen meegenomen worden.

Om het probleem op te lossen zouden of de merged cellen verwijderd moeten worden. Of je zult een andere kopieer actie moeten laten plaatsvinden. Ik wil je wel helpen met het opstellen van een andere manier, maar dat maak ik vandaag niet af .

Hopelijk heb je zo eerst voldoende informatie.

Met vriendelijke groet,

Tilly

 

[rkootje]

Hoi Tilly,

ik denk niet dat, dat het probleem is. als je nl. de regels van de beveiliging verwijderd, of op nonactief zet, werken alle functies naar behoren, wanneer je echter de beveiliging weer actief maakt stopt de code bij, Activesheet.paste
voor zover ik het kan zien is het blad niet van de beveiliging op het moment dat er op het "blad gegevens " de gegevens van blad1 moet worden gekopieerd.
daarom moet het blad van de beveiliging, voordat er wordt geselecteerd, maar dat kan ik verder niet goed werkend krijgen.

gr, Rkootje

 

[Tilly1987]

Probleem zit in de Range namen

Hey rKootje,

Het probleem zit hem deels in de merged cellen probleem. Als je een range kopieert waarin een merged cel zit, dient het uiteindelijke bestemming dezelfde indeling te hebben. Dus ook een merged cel, als dit al opgemaakt is zoals jouw'n bestand, zou dit kunnen werken. Voor het geval dat dit niet opgaat resulteert dit in een error.

Wat is nu het probleem in jouw'n bestand, je kopieert de Range("copie"), dat Range("B3:I68") beslaat op Blad1. Dit wil je gaan kopieren naar Gegevens in bv. Range("Week1"), deze beslaat Range("C3:J65"). Dit zal niet gaan gezien de de ranges qua opmaak verschillen (Laatste drie regels worden niet meegenomen (opmerkingen veld)).

Er zijn verschillende oplossingen mogelijk:
1) Pas Range("copie") aan naar Range("B3:I65")
2) Pas alle Range("Week_") aan naar Range("__3:__68")

Verder heb ik beneden een nette versie van jouw'n gewenste code neergezet. Hopelijk heb je er iets aan.

Met vriendelijke groet,

Tilly

Private Sub cmbwwoke_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Dim week As String

'Gaat naar lbl Catch_Error als fout optreed
On Error GoTo Catch_Error

'Stel referenties in.
Set wb = ThisWorkbook
Set ws2 = wb.Worksheets("Gegevens")
Set ws1 = wb.Worksheets("Blad1")

'Krijg de week waarde van blad1 combobox
week = ws1.OLEObjects("Cbbkeuzeweek").Object.Value

'Test wachtwoord
If Not Txtww = "Alfred" Then
    MsgBox "Wachtwoord onjuist"
Else
    'Vul de merged cel waarde in en kleur deze
    With ws1.Range("B4:E4")
        .FormulaR1C1 = "Acc. AKL"
        With .Interior
            .ColorIndex = 4
            .Pattern = xlSolid
        End With
    End With

End If

    'Dit wordt dus altijd uitgevoerd ongeacht of het wachtwoord verkeerd is!
    'Weet niet of dat je dat ook wou, maar ander dien je onderstaande code bij de
    'Else stuk van test wachtwoord in te zetten.
    Application.ScreenUpdating = False  'Dit dient het scherm flikkeren op te lossen, het is nu niet nodig, want ik verander niet het actieve werkblad!
    ws2.Unprotect Password:="x"
    ws1.Range("copie").Copy
    ws2.Range(week).PasteSpecial
    ws2.Protect Password:="x", UserInterfaceOnly:=False
    Application.CutCopyMode = True      'Toont kopieer-selectie niet meer
    Application.ScreenUpdating = True   'Zie eerste opmerking Application.screenupdating
    
    Unload Me
Exit Sub

Catch_Error:
    'Dit voorkomt dat een foutmelding de screenupdatin = true
    'waarde niet uitvoert.
    Application.ScreenUpdating = True
    Unload Me
End Sub

 

[rkootje]

Hoi Tilly, werkt niet!

Ik heb je code gekopieerd, maar wanneer ik die macro activeer, zie je dat, nadat je het wachtwoord hebt ingevuld, de juiste week wordt geselecteerd op het blad gegevens, maar daar blijft het bij, niets wordt gekopieerd, blad wordt niet beveiligd, en als je schakeld naar blad1 zie je dat "copie" nog steeds is geselecteerd.

 

[rkootje]

bestandje meegezonden,

ik dacht dat ik je een bestandje had meegestuurt, maar zie dit nergens in de vraag terug, vandaar ik deze nog een toevoeg.Bekijk bijlage Test urenregistratieemail1.zip
in geval alvast bedankt.

 

[Tilly1987]

Zie bijlage

Ik heb de copie range aangepast, dus commentaar wordt niet mee gekopieerd. Wil je dit wel dan zal je alle week ranges aan moeten passen. Probleem zat hem in de beveiliging. Als de beveiliging eraf wordt gehaald. Verliest hij de copy range. Zal het aanpassen in mijn vorige post. Mijn excuses had het er later bij gezet en niet getest .

Groet'n
Tilly

Op een of andere wijze wil hij geen bijlage direct toevoegen via het forum. Dan maar zo.
http://hotfile.com/dl/136579472/3126a1d/Test_urenregister.zip.html

 

[rkootje]

Hoi Tilly vraagje

Allereerst dank, dat werkt goed, maar ik heb jou code gezet in mijn blad, maar daar werkt het niet, verder heb ik op die zelfde wijze getracht om die code om bij de ander knoppen toe te passen, echter zonder resultaat.
als je het 1e blad kijkt, wil ik dit ook beveiligen, als je immers de tekst verwijderd uit het Cells (4,2) kun je de uren gewoon aanpassen. dus dacht ik, als ik een regel toevoeg van ws1.Unprotect Password:="x" en ook ws1.Protect Password:="x", UserInterfaceOnly:=False, dan zou het blad1 ook beveiligd worden, alle cellen van uren zo ik het vinkje verwijderen van geblokeerd en de rest laten staan voor geblokkeerd.
dan zou die velden niet bewerkbaar zijn, maar dat gaat blijkbaar niet op.
verder als ik akk registratie druk slaat die weer vast, zelfs bij het aanpassen zoals jij dat hebt gedaan bij de oke knop van het userform.
mijn totale document is uiteraard groter, met diverse verwijziging, maar als ik die verstuur blijkt deze te groot te zijn, ik wil hem wel toesturen naar je maar weet niet hoe jij dat deed via internet.

kun jij me weelicht helpen?

gr. rkootje

 

[rkootje]

Hoi Tilly, opgelost!

Ik heb het opgelost, het werkt nu naar behoren.
dank je voor je support, gr.
Rkootje