Opmaak terugzetten

Status
Niet open voor verdere reacties.
L

Lampie173

Gebruiker
Lid geworden
21 jan 2012
Berichten
154
Goedemiddag Excellers,

Met behulp van diverse forummers:thumb:, wat eigen zoekwerk en husselen van de code, ben ik tot het volgende bijgevoegd Testbestand gekomen.

Het is de bedoeling dat als ik in bereik B2:Q32 een cel activeert deze een Lichtblauwe kleur krijgt en dat een cel in kolom Q op dezelfde rij rood wordt met bepaalde opmaak, vet onderstreept en fontgrootte 13 krijgt.
Nadat ik in het bereik een andere cel activeer moet de rode cel zijn oorspronkelijke opmaak keijgen, niet vet, geen onderstreping, fontgrootte 11 en standaard rijhoogte (15) en natuurlijk gaat de blauwe kleur verdwijnen in het bereik om op de gekozen cel weer te verschijnen.

Het eerste deel van mijn missie is gelukt, wat ik al zei, door medeforummers en wat zelf proberen, maar het tweede gedeelte van mijn verhaal hierboven lukt me niet.:confused:

Heb diverse stukjes code op diverse plekkeen in de code gezet, maar zonder resultaat.

Alvast bedankt voor het lezen.


Met vriendelijke groet,

Toon
 

Bijlagen

  • Test.xlsm
    15,6 KB · Weergaven: 38
Je bent op de goede weg

Hallo,

Je kan het hier mee proberen.
In plaats van elke cel apart terug te zetten kan je ook het hele gebied in een keer terug zetten.
En vervolgende de cellen in de geselecteerde regel de goede opmaak geven;

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
Dim tr As Integer
Dim mycolor As Integer
Dim mycolor1 As Integer

tr = Target.Row
mycolor = 8
mycolor1 = 3
z = 18

If Not Intersect(Range("B2:Q32"), Target) Is Nothing Then
Range("B2:R32").Interior.ColorIndex = -4142
With Range("R2:R32")
With .Font
.Underline = False
.Bold = falue
.Size = 11
End With
End With

Range(Cells(tr, 2), Cells(tr, 17)).Interior.ColorIndex = mycolor
With Cells(tr, z)
.Interior.ColorIndex = mycolor1
With .Font
.Underline = 2
.Bold = True
.Size = 13
End With
End With

End If

End Sub

Ik hoop dat dit helpt.
 
Dag Wouter,

Wow!
Dat ziet er kort en krachtig uit:cool:

Toch nog 1 vraagje:
Als ik nu buiten de range B2:R32 een cel activeert, dan blijft een gekozen rij binnen de range zeg maar de kleur en opmaak houden.
Wat moet ik toevoegen om standaard opmaak te verkrijgen?

Groet,

Toon
 
Dat wordt een kleine aanpassing.
Het wissen van de opmaak voor de controle zetten:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
Dim tr As Integer
Dim mycolor As Integer
Dim mycolor1 As Integer

tr = Target.Row
mycolor = 8
mycolor1 = 3
z = 18

Range("B2:R32").Interior.ColorIndex = -4142
With Range("R2:R32")
With .Font
.Underline = False
.Bold = falue
.Size = 11
End With
End With

If Not Intersect(Range("B2:Q32"), Target) Is Nothing Then
Range(Cells(tr, 2), Cells(tr, 17)).Interior.ColorIndex = mycolor
With Cells(tr, z)
.Interior.ColorIndex = mycolor1
With .Font
.Underline = 2
.Bold = True
.Size = 13
End With
End With

End If

End Sub
 
Hoi Wouter,


Ik ben te onduidelijk in mijn vraagstelling geweest.

Ik ben idd aan het verschuiven van de opmaak geweest, maar dat betreft alleen de rode opgemaakte cel.

Wat ik bedoel is: Dat als ik buiten het bereik B2:Q32 een cel activeer, dat dan de blauwe regel en de rode cel "uit" gaan, dat het dus een gewone 'witte' regel wordt.

Zoals ik het omschreef lijkt het alleen de roodgekleurde cel te zijn, maar ik bedoelde dus het bereik B2:Q32


Dank voor je snelle reactie,
 
Wat werkt er niet aan de laatste code dan?

Maak gebruik van inspringspunten en variabelen die je maar 1 keer gebruikt kan je net zo goed weglaten. De formule in Kolom R klopt niet deze geeft een 'circular reference'

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With Range("B2:R32").Font
    .Underline = False
    .Bold = False
    .Size = 11
    .Parent.Interior.ColorIndex = -4142
  End With

  If Not Intersect(Range("B2:Q32"), Target) Is Nothing Then
    Cells(Target.Row, 2).Resize(, 16).Interior.ColorIndex = 8
      With Cells(Target.Row, 18).Font
        .Underline = 2
        .Bold = True
        .Size = 13
        .Parent.Interior.ColorIndex = 3
      End With
  End If
End Sub
 
Laatst bewerkt:
Goedemorgen VenA,

Zie onderstaande code, die ik aan de hand het advies van WoutMag al had geknutseld.

Wat er in div voorgaande codes niet werkte was (wat onderstaande inmiddels wel doet) dat de 'opgelichte rij' op 'uit' ging als je buiten de Range B2:R32 een cel activeert.

Jouw (korte) code voldoet nu ook aan mijn wens. :thumb:

Even toch een vraagje:
FALUE is dat nieuw in VBA? Want de code werkt wel, ik zag dit ook al in de code van WoutMag, en daar heb ik het 'verbeterd' in FALSE

Nogmaals dank

Toon

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
Dim tr As Integer
Dim mycolor As Integer
Dim mycolor1 As Integer

tr = Target.Row
mycolor = 8
mycolor1 = 3
z = 18

With Range("R2:R32")
With .Font
.Underline = False
.Bold = False
.Size = 10
End With
End With
Range("B2:R32").Interior.ColorIndex = 2
'Range(Cells(tr, 18), Cells(tr, 18)).Interior.ColorIndex = 3

If Not Intersect(Range("B2:Q32"), Target) Is Nothing Then
Range("B2:R32").Interior.ColorIndex = -4142



Range(Cells(tr, 2), Cells(tr, 17)).Interior.ColorIndex = mycolor
With Cells(tr, z)
.Interior.ColorIndex = mycolor1
With .Font
.Underline = 2
.Bold = True
.Size = 11
End With
End With

End If

End Sub
 
Falue is een typefoutje van @WoutMag, die ik bij het inkorten van de code heb overgenomen. Wel jammer dat je niets met mijn suggestie hebt gedaan behalve de code te testen.
 
Laatst bewerkt:
Goedenavond VenA,

Dank voor je terugkoppeling.

Ik heb jouw suggestie juist wel ter harte genomen, omdat het een mooie kort stukje code is tov van wat ik als bijlage had gepost!
Even terugkomend op het typefoutje: Ik kreeg helemaal geen foutmelding of dat de code vastliep, alles doet het gewoon!
Heb zelfs nog gezocht of het een nieuwe toevoeging aan het VBA was!:d:d
Ik begreep later dat het een typefout was.

Groet,

Toon
 
En ik kijk net:
Staat jouw overgenomen fout er nog steeds in!!:d:d
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  With Range("B2:R32").Font
    .Underline = False
    .Bold = falue
    .Size = 10
    .Parent.Interior.ColorIndex = -4142
  End With

  If Not Intersect(Range("B2:R32"), Target) Is Nothing Then
    Cells(Target.Row, 2).Resize(, 16).Interior.ColorIndex = 8
      With Cells(Target.Row, 18).Font
        .Underline = 2
        .Bold = True
        .Size = 12
        .Parent.Interior.ColorIndex = 3
      End With
  End If
End Sub

En het doet wat het moet doen!:shocked:
 
In het bericht in #6 volgens mij de hele dag al niet meer.:d

Dat het alsnog werkt komt doordat .Bold een Boolean verwacht. Falue wordt in deze gezien als een niet gedeclareerde variabele die de standaardwaarde FALSE meekrijgt. Vervang Falue maar door Lampie173.
 
VenA,

Even toch nog een vraag:

jouw code werkt dus prima.
Nu kleurt de active.Row blauw en de cel in de laatste kolom rood.
Op het moment dat ik een bedrag invul in het bereik (blauwe rij) dan wordt het bedrag in de rode cel aan het eind ingevuld en onderstreept, so far, so good.
Op het moment dat er in de selectie geen bedragen staan, moet alleen blauwe rij zichtbaar zijn.

Kan jij een mooie aanzet geven, ik was alweer bezig om te knippen en te plakken maar daar kom ik niet ver mee
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  With Range("B2:R32").Font
    .Underline = False
    .Bold = False
    .Size = 10
    .Parent.Interior.ColorIndex = -4142
  End With

  

  If Not Intersect(Range("B2:R32"), Target) Is Nothing Then
    Cells(Target.Row, 2).Resize(, 16).Interior.ColorIndex = 8
      With Cells(Target.Row, 18).Font
        .Underline = 2
        .Bold = True
        .Size = 12
        .Parent.Interior.ColorIndex = 3
      Else
      With Cells(Target.Row, 18).Font
      .Underline = False
      .Bold = False
      .Size = 10
      .Parent.Interior.ColorIndex = -4142
    End With
  End If
End Sub

Dit is wat ik nu heb, en krijg uiteraard een foutmelding op Else


Groet,

Toon
 
Laatst bewerkt:
Voor de Else mist een End With

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
  With Range("B2:R32").Font
    .Underline = False
    .Bold = False
    .Size = 10
    .Parent.Interior.ColorIndex = -4142
  End With
  
  If Not Intersect(Range("B2:R32"), Target) Is Nothing Then
    Cells(Target.Row, 2).Resize(, 16).Interior.ColorIndex = 8
    With Cells(Target.Row, 18).Font
      .Underline = 2
      .Bold = True
      .Size = 12
      .Parent.Interior.ColorIndex = 3
    End With
  Else
    With Cells(Target.Row, 18).Font
      .Underline = False
      .Bold = False
      .Size = 10
      .Parent.Interior.ColorIndex = -4142
    End With
  End If
End Sub

Helpt dit?
 
Dag Wouter,

Bedankt voor je reactie.

Nee niet echt.
ben zo vrij geweest om je een pb te sturen.

Groet,

Toon
 
Wat gaat er mis met voorwaardelijk opmaak? Nog geen reactie op gezien.
 
Goedemorgen VenA,

Dank voo r je reactie,

Door prive omstandigheden was ik niet eerder dan gisteren in staat om te reageren, sorry daarvoor.

in toegevoegde bestand werkt binnen het bereik alles prima, maar wat ik zou willen is dat als er het bereik een rij geselecteerd wordt (deze licht dan lichtblauw op) waarin geen bedrag is ingevuld, dat in dan de laatste cel (Q..) van dat bereik, een standaard opmaak heeft, dus geen rode kleur, geen fin. opmaak en niet onderstreept of vet.

Gewoon een lege cel aan het einde van de (geselecteerde) lichtblauwe rij.

Ik hoop dat je mij kunt helpen,

Alvast bedankt voor het lezen,

Groet,

Toon
 

Bijlagen

  • Test.xlsm
    17,1 KB · Weergaven: 31
AARGGG!!!!!!

Argumenten tuurlijk! Dat is 'm!

Top bedankt voor je tijd,

Ik sluit dit draadje.

Groet,

Toon
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan