Bereik benoemen in code

[Roma]

Beste forumgebruikers,

Ik heb van forumgebruiker Roncancio een zeer nuttige code gekregen (tabblad KWART1). Ik dacht dat ik er was maar helaas. De code werkt over het hele tabblad. Gezien er meer cellen niet beveiligd zijn moet er een de code het bereik benoemd worden. (grijze cellen). ik heb het geprobeerd maar dat lukt me niet. Tevens de vraag of ik deze code in een module kan plaatsen zodat ik ze op 4 tabbladen (allemaal de zelfde) kan gebruiken.

Bij voorbaat bedankt
Ron

 

[HSV]

Zo zou je in elk blad de range kunnen aanroepen "Sub hsvtwee()", na het draaien van "Sub hsv()".
Om je een indruk te geven wat "Split" doet heb ik de rode regels toegevoegd die je mag verwijderen.

Sub hsv()
Dim area As Range, y As Long, Nm As Name
 For Each area In ActiveSheet.UsedRange.SpecialCells(2).Areas
     y = y + 1
     Range(area.Address).Resize(, 32).Name = "bereik" & y
 Next area
   [COLOR=#FF0000]For Each Nm In Names
     msgbox nm.refersTo
     MsgBox Split(Nm.RefersTo, "!")(1)
   Next Nm[/COLOR]
End Sub

 

[Roma]

Harry,
Bedankt voor je reactie. Ik heb het ingevoerd maar helaas hij doet niks. Wat doe ik dan fout?

 

[HSV]

Zo daar was ik weer.
Verander het naar zo.

Sub hsvtwee()
 Range(Range("bereik1").Address) = 1
End Sub

Let wel dat voor deze test overal een 1 in het bereik komt van het actieve blad.
Zo kun je het testen door in een ander blad de code laten lopen.

 

[Roma]

Harry,
sorry maar hij doet helemaal niets

 

[HSV]

Je moet wel de bereiken benoemen met "sub hsv()".

 

[Roma]

Harry, Ik blijf lastig en misschien stom maar hij doet echt niets

 

[HSV]

Haal je de beveiliging er ook af ?

Sub hsvtwee()
ActiveSheet.Unprotect
 Range(Range("bereik1").Address) = 5
 ActiveSheet.Protect , , , True
End Sub

Hetzelfde geldt voor sub hsv().

 

[Roma]

Harry,
helaas

 

[HSV]

Kan ik me voorstellen.

Je geeft er zelf weer een draai aan.
Dit is niet hetzelfde als in #2.

Sub hsv()
Dim area As Range, y As Long, Nm As Name
 For Each area In ActiveSheet.UsedRange.SpecialCells(2).Areas
     y = y + 1
     Range(area.Address).Resize(, 32).Name = "C9:AG43,C53:AG87,C96:AG130 " & y
 Next area
   ''For Each Nm In Names
   ''  MsgBox Nm.RefersTo
   ''  MsgBox Split(Nm.RefersTo, "!")(1)
  '' Next Nm
End Sub

Zo heb je in elk bladmodule een code hsvtwee()
Die hoort daar niet toch?
Eén keer is genoeg in een standaardmodule.

Ik wil wel helpen, maar zo is het onbegonnen werk.

 

[Roma]

Beste Harry,
Bedankt voor je inzet in mijn problematiek. Ik krijg het niet opgelost. Waarschijnlijk moet ik het orkest betalen.
Ron

 

[HSV]

Hier alles in je bestandje gezet Ron.

In elk blad doet 'Sub hsvtwee()' het hetzelfde.

 

[Roma]

Harry bedankt

 

[HSV]

Graag gedaan Ron.

Ik hoop dat je er een beetje uitkomt zo, want je wil er misschien iets anders mee doen dan er een cijfer inzetten.

Anders verneem ik het wel weer.

 

[Roma]

Harry,
Bedankt voor je inzet. Ja ik wil de codes gebruiken die op tabblad kleur staan. Ik heb het vanmorgen uitgeprobeerd maar het bereik is nog steeds niet benoemd. Ik heb het bereik benoemd zoals beschreven in #6 maar in kan de andere niet beveiligde cellen gewoon invoeren. Met andere woorden vul ik daar gegevens in die niet in het tabblad kleur staan dan geeft de code de gemaakte foutmelding.
Deze code is voor mij zeer belangrijk omdat het in een Excel rooster geplaatst wordt voor de financiële administratie. Dit om fraude te voorkomen.
Ik hoop dat je mij nog verder wil helpen daar ik nog te weinig afweet van VBA.
mgv
Ron

 

[HSV]

Wat moet er gebeuren in de code.
Kan je de handelingen beschrijven die je uitvoerd, en wat er dan vervolgens moet gebeuren met het bereik.

 

[Roma]

Harry bedankt dat je mee wilt denken.
Het bereik van de code zijn de cellen: C9:AG43, C53:AG87, C96:AG130 dit voor de tabbladen kwart1,2,3,4
Daar mogen alleen de codes in die staan op het tabblad Kleur.
Enkele cellen op de tabbladen zijn vrij voor invoer.

Ron

 

[HSV]

Maak eens een voorbeeldje hoe het er uit moet zien, en met een goede beschrijving van de acties die je doet in tabblad 'Kleur'.
Ik begrijp er niet veel van.
Er staat geen code in tabblad 'Kleur'.
Het zit allemaal in jouw hoofd, maar ik moet raden.

 

[Roma]

Harry,
Zoals gevraagd een bestand met toelichting.
Ron

 

[HSV]

Misschien zo?

Verwijder eens de code in Kwart1.
Zet onderstaande eens in ThisWorkbook.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Sheets("Kleur").Range("C7:G32")
        Set c = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        ActiveSheet.Unprotect ""
        If Not c Is Nothing Then
            Target.Interior.Color = c.Interior.Color
'            Target.Offset(44).Interior.Color = c.Interior.Color
'            Target.Offset(87).Interior.Color = c.Interior.Color
        Else
            Target.Interior.Color = xlNone
            MsgBox "Je hebt een ongeldige code gekozen." & vbNewLine & "Kies een andere code.", vbExclamation, "Kleurencode."
            Target.Value = ""
        End If
    End With
    ActiveSheet.Protect ""
End Sub