Aanpassen Range Voorwaardelijke opmaak

Status
Niet open voor verdere reacties.

Excellerend

Gebruiker
Lid geworden
8 nov 2011
Berichten
68
Beste Forumleden,

In heb een beveiligd excel-bestand waarin het enkel mogelijk is de onbeveiligde cellen te benaderen en gebruik te maken van de autofilter.
Het toevoegen van een rij werkt middels een macro, die wordt geactiveerd bij het dubbelklikken in kolom A.

Ik heb mijn bestand vereenvoudigd naar een voorbeeldbestand (Range_voorwaardelijke_opmaak.xlsm) waar in kolom B (gedefinieerde naam = Status) een voorwaardelijke opmaak staat.

De voorwaardelijke opmaak is op basis van een getal die handmatig moet worden ingevoerd (1/2/3). De voorwaardelijke opmaak moet gelden van B2 tot en met B18.
De gehele rij 18 (gedefinieerde naam = Laatste_regel) is verborgen zodat de dynamische range "Status" altijd gehandhaafd blijft.

Alles blijkt te werken, maar op de achtergrond vormt zich één probleem. Zodra ik een rij toevoeg (middels de macro) wordt het bereik van de voorwaardelijke opmaak onderbroken en wordt er een nieuwe voorwaardelijke opmaak regel toegevoegd enkel voor de toegevoegde cel(len) in kolom B.

Graag zou ik willen dat het bereik van de voorwaardelijke opmaakt begint in B2 en ononderbroken doorloopt tot kolom B / rij Laatste_regel.

Diverse pogingen geprobeerd, zoals de onderstaande code, maar die maakt voor elke regel apart een voorwaardelijke opmaak regel aan...

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lRegels As Long
Dim lTargetRegel As Long
'Dim VWopmaak_bereik As Range

    If ActiveCell.Column = 1 Then
    
    Application.ScreenUpdating = False
    lTargetRegel = Target.Row
    
    lRegels = Application.InputBox("Hoeveel regels wil je onder de geselecteerde regel toevoegen?", "Toevoegen regels", 1, , , , , 1)
    If lRegels = 0 Then Exit Sub
    Target.EntireRow.Copy
    Rows(lTargetRegel + 1 & ":" & lTargetRegel + lRegels).Insert Shift:=xlDown
    On Error Resume Next
    Target.Offset(1).Resize(lRegels).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
    Application.CutCopyMode = False
    

'    For Each VWopmaak_bereik In Range("Status")
'    VWopmaak_bereik.FormatConditions.AddIconSetCondition
'    VWopmaak_bereik.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
'    With VWopmaak_bereik.FormatConditions(1)
'        .ReverseOrder = False
'        .ShowIconOnly = True
'        .IconSet = ActiveWorkbook.IconSets(xl3Symbols)
'    End With
'    With Selection.FormatConditions(1).IconCriteria(2)
'        .Type = xlConditionValueNumber
'        .Value = 1.1
'        .Operator = 7
'    End With
'    With Selection.FormatConditions(1).IconCriteria(3)
'        .Type = xlConditionValueNumber
'        .Value = 2
'        .Operator = 5
'    End With
'
'    Next
    
    Target.Offset(1).Select
    If Err > 0 Then Exit Sub
   
Application.ScreenUpdating = True
End If
End Sub

Ik hoor graag jullie ideeën.

Grt Peter

Bekijk bijlage Range_voorwaardelijke_opmaak.xlsm
 
Peter,

De voorwaardelijke opmaak wordt alleen onderbroken als er vanaf het begin al een breuk inzit.
Als ik je bestand dat je meegestuurd hebt zul je zien dat er een breuk inzit.
Verwijder deze eerst en werk daar verder mee dan zullen verdere breuken niet ontstaan.

Veel Succes.
 
Beste Elsendoorn2134,

De situatie zoals jij schetst heb ik getest voordat ik het topic opende. Starten met of zonder een breuk maakt bij mij geen verschil. Ik heb het zojuist nogmaals geprobeerd maar helaas creëert hij 'weer' een breuk.

Ik gebruik overigens Office2010.

Grt Peter
 
Een kleine aanvulling, als je een regel toevoegt aan het voorbeeld bestand dit enkel te doen door te dubbelklikken in rij A.

Via Invoegen --> Bladrijen invoegen ontstaat het probleem niet. (maar zoals gezegd is mijn hoofdbestand beveiligd, ook tegen het invoegen van rijen)
 
Gebruik een tabel:

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If ActiveCell.Column = 1 Then
        y = InputBox("Hoeveel regels wil je onder de geselecteerde regel toevoegen?", "Toevoegen regels", 1)
        If y = 0 Then Exit Sub
        Rows(ListObjects(1).Range.Rows.Count - y & ":" & ListObjects(1).Range.Rows.Count).Insert
    End If
End Sub
 

Bijlagen

Laatst bewerkt:
Beste snb,

Helaas is het gebruik maken van een tabel in mijn sheet niet handig, de reden daarvan is dat ik meerder "bereiken" heb die elkaar overlappen.
Die "bereiken" moeten afhankelijk van de functie verborgen zijn of niet.

Toch heb ik er een tabel van gemaakt, en het probleem met de voorwaardelijke opmaakt is opgelost, waarvoor dank.

Maar middels jouw stukje code kom ik een volgend probleem tegen, zie bijgevoegde sheet.

Bekijk bijlage Range_voorwaardelijke_opmaak(2).xlsm

Als ik in rij 6 middels de macro 6 of 7 rijen (of meer) wil toevoegen gaat het niet goed.
Met de vorige macro werd de functie "Resize" gebruikt, dan werkt het blijkbaar wel..

Is jouw code ook mogelijk met de functie "Resize"?

Grt Peter
 
Problem solved

Het probleem is opgelost en wel door eerst de voorwaardelijke opmaak te verwijderen ...
Code:
    With VWopmaak_bereik.FormatConditions.Delete
    End With
... en vervolgens over het gehele bereik de voorwaardelijke opmaak weer toe te passen.
Code:
    With VWopmaak_bereik.FormatConditions.AddIconSetCondition
    VWopmaak_bereik.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With VWopmaak_bereik.FormatConditions(1)
        .ReverseOrder = False
        .ShowIconOnly = True
        .IconSet = ActiveWorkbook.IconSets(xl3Symbols)
    End With
    With Selection.FormatConditions(1).IconCriteria(2)
        .Type = xlConditionValueNumber
        .Value = 1.1
        .Operator = 7
    End With
    With Selection.FormatConditions(1).IconCriteria(3)
        .Type = xlConditionValueNumber
        .Value = 2
        .Operator = 5
    End With
    End With

Uiteraard wel eerst het bereik toewijzen:
Code:
Set VWopmaak_bereik = Range("Status")

Allen bedankt!

Peter
 
Ik zie geen enkel probleem met:

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 Then
        y = InputBox("Hoeveel regels wil je onder de geselecteerde regel toevoegen?", "Toevoegen regels", 1)
        If y = > Then  Rows(ListObjects(1).Range.Rows.Count).Resize(y).Insert
        Cancel = True
    End If
End Sub

PS. Ik hoop dat je weet dat een tabel allerlei ingebouwde benoemde gebieden heeft ?
 
snb,

Hierbij het probleem middels een afbeelding. Ik hou het even op mijn 'eigen' oplossing tenzij daar grote bezwaren tegen zijn..

Range_prob.jpg

Grt Peter
 
Dat lijk met geen probleem maar een plaatje; en dat zegt nu eenmaal niets.
Heb je mijn suggestie in het eerdere voorbeeldbestand dat ik plaatste getest ?
 
snb,

Ik heb je bestandje getest, en dat werkt perfect. (behalve als je meer rijen invoegt dan dat er op dat moment 'zichtbaar' zijn. Voeg bijvoorbeeld 60 rijen toe en dan geeft dat (uiteraard) een fout.)
Ik heb jouw code in mijn voorbeeldbestandje getest en ik kreeg o.a. hetgeen op de afbeelding te zien is.

Maar het probleem zit hem meer in het gebruik van een tabel. Om met jouw voorbeeldbestandje te werken; rij 1 t/m 5 moet een RANGE(1) zijn, bereik 6 t/m 10 moet een RANGE(2) zijn én bereik 3 t/m 10 moet een RANGE(3) zijn.
Naar gelang de functie van het rapport (te kiezen via een UserForm met 3 opties) moet RANGE 1 of 2 of 3 zichtbaar zijn (incl. een reset-optie). Dit kan eenvoudig door elke RANGE een gedefinieerde naam te geven en deze met de onderstaande code wel/niet te verbergen.
Code:
Range("RANGE(1)").EntireRow.Hidden = True 'of False

Met mijn beperkte kennis is het volgens mij niet mogelijk om voor diverse overlappende bereiken een tabel te maken, dus vandaar prefereer ik mijn optie boven die van jou.
Al sta ik natuurlijk altijd open voor betere ideeën, waarvan er reeds zovelen van jouw hand afkomstig zijn :)

Grt Peter
 
Ipv drie bereiken kun je ook een extra kolom aan de tabel toevoegen en daarmee filteren. Per rij geef je in die kolom aan tot welk "bereik" de rij hoort:
A = behoort tot bereik A
B = behoort tot bereik B
AB = behoort tot bereik A en bereik B
Gebruik de tekstfilter "bevat"
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan