hele regel laten oplichten tijdens het invullen

[Warme bakkertje]

Dat hij slechts kleurt naar links is correct. Heb 'm zelf nog niet getest in XL2007, zal straks eens proberen.

 

[danny147]

Beste kuin047

Zie bestandje.

Groetjes Danny. :thumb:

 

[trucker10]

Dat hij slechts kleurt naar links is correct. Heb 'm zelf nog niet getest in XL2007, zal straks eens proberen.

Rudi in xl2007 en ook 2010 loopt het fout in 2010 loopt het hiet fout

.Line.Visible = msoFalse
                .Left = 0
                .Width = cl.Left + cl.Width
                .Top = cl.Top
                .Height = cl.Height

 

[cow18]

aanpassing van de code van warme bakkertje, maar er klopt precies iets niet met de horizontale als je naar beneden scrollt. De Top is precies niet eenduidig te bepalen, misschien ziet iemand mijn fout ? Het eigenaardige is dat de vertikale altijd netjes kleurt ????

Sub Draadkruis_aanmaken()
  Dim shp As Shape, cl As Range, t%
  With ActiveSheet

    MaakShape "Draadkruis_Horizontaal"
    .Shapes("Draadkruis_Horizontaal").Select
    With Selection.ShapeRange
      .Left = 0
      .Width = ActiveCell.Left + ActiveCell.Width
      .Top = ActiveCell.Top + ActiveCell.Height
      .Height = ActiveCell.Height
    End With

    MaakShape "Draadkruis_Vertikaal"
    .Shapes("Draadkruis_Vertikaal").Select
    With Selection.ShapeRange
      .Left = ActiveCell.Left
      .Width = ActiveCell.Width
      .Top = 0
      .Height = ActiveCell.Top + ActiveCell.Height
    End With
    ActiveCell.Select
  End With
End Sub

Sub MaakShape(naam As String)
'deze macro kijkt of er een bepaalde shape bestaat, zoniet maakt ze die aan
  If naam = "" Then MsgBox "foute naam ": Exit Sub
  Dim shp      As Shape
  With ActiveSheet
    On Error Resume Next
    Set shp = .Shapes(naam)                                'probeer gevraagde shape aan te roepen
    If Not shp Is Nothing Then Exit Sub                    'gevraagde shape bestaat, dus OK
    .Shapes.AddShape(msoShapeRectangle, 0, 0, 0, 0).Select 'maak een nieuwe shape aan
    With Selection
      .Name = naam 'benoem die met gewenste naam
      With .ShapeRange 'vanaf hier gewenste kenmerken aanmaken
        With .Fill
          .Visible = msoTrue
          .ForeColor.SchemeColor = 6                       'pas deze aan als je een andere kleur wilt hebben
          .Transparency = 0.5                              '<- pas deze aan als je de transparantie hoger of lager wilt hebben
        End With
        .Line.Visible = msoFalse
        .Left = 1
        .Width = 1
        .Top = 1
        .Height = 1
      End With
    End With
  End With
End Sub

 

[kuin047]

try out

Het volgende geprobeerd.
van het bestand active cel +kolom kleuren heb ik de tabbladen die ik niet wil verwijderd.
Vervolgens blad1 en blad2 opnieuw aangemaakt.
Toen de code in het vbaproject op de tabbladen gezet.
Volgens mij zou het dan moeten werken.
Maar dat doet hij niet, dus waar zit ik fout??

Bekijk bijlage Kopie van Avtieve cel + kolom en rij kleuren..xls

 

[danny147]

Beste kuin047

Als het om mijn bestandje gaat moet je ook de formule in de Voorwaardelijke Opmaak plakken.

Groetjes Danny. :thumb:

 

[cow18]

nu lukt het blijkbaar wel, maar nog niet 100% naar mijn zin

 

[danny147]

Beste kuin047

Zie bestandje.

Groetjes Danny. :thumb:

 

[kuin047]

er gaat iets fout

Ik zie de reactieberichten pas als ik een reactie plaats dus ik ga even verder met jullie antwoorden.
Tot later.......

Ik zie het al, er is een vervolgpagina , ik zit steeds op de eerste te kijken. Ik ga rommelen.

 

[danny147]

Beste kuin047

Zie mijn uitleg in post#36 en bestandje in post#38.

In de Voorwaardelijke Opmaak kijken.
Via Opmaak --- Voorwaardelijke Opmaak en kijk daar naar de formule.

Groetjes Danny. :thumb:

 

[kuin047]

oke

Ik heb weer wat materiaal om verder te rommelen.
Ik moet weer werken, dus tot later.
Wil er toch achter komen wat ik fout doe.
Iedereen bedankt tot dusver

 

[cow18]

ik keer even terug op mijn vorig probleempje dat nu opgelost lijkt, het was als het zoompercentage <>100 dat ik in de problemen kwam
zie bijlage

 

[trucker10]

Cow18 :thumb: Werkt in 2007 en 2010 ! :thumb: Maar hoe vul ik data in onder de gekleurde lijn ?

 

[cow18]

dan ben je gefocust op dat ene probleem en dan vergeet je dat andere.
Dus een kleine aanpassing. De voorwaardelijke opmaken van Danny zijn ook verdwenen, want die vertraagden de boel maar.

 

[kuin047]

yessss

Danny, toch met jouw bestand en voorwaardelijke opmaak een goed resultaat gekregen.
Ik ga verder rommelen. merci.

ps cow 18 hij kleurt naar links en naar boven.
Is een beetje te veel. ik wil m alleen horizontaal.
Met de voorw. opmaak van Danny is het me nu eindelijk gelukt.
En ik programmeer hem in de blokken die ingevuld moeten worden.

 

[cow18]

dan haal je dat stuk met draadkruis vertikaal er gewoon uit.
Wil je het ook enkel voor bepaalde rijen gebruiken, dan pas je dat aan in die worksheet_change_event.
Maar blijkbaar ga je voor de andere optie ?

 

[kuin047]

Ff aanpassen??

pas je dat aan in die worksheet_change_event.

Ja dat is gemakkelijk gezegt. Zoveeeel ervaring heb ik niet dat ik het "even" aanpas.
Maar ik ben nog niet klaar met uitproberen, dus ik ga nog verder puzzelen.

 

[cow18]

aangepaste versie in bijlage
- alleen een horizontaal draadkruis
- enkel op die rijen met een datum

 

[kuin047]

ja, dat kan ik niet.

Ik kan zelf die veranderingen niet allemaal aanbrengen omdat ik de juiste termen niet weet.
Maar nu kleurt hij alleen naar links op en als je daarna het beeld verschuift naar links dan blijft alleen het gedeelte dat in beeld was gekleurd, dus hij loopt niet door naar helemaal links als het niet op het scherm staat.
Begrijp je het nog?

 

[cow18]

dat vergt een kleine aanpassing, die je ook zelf zou kunnen (???)

Sub Draadkruis_aanmaken()
  Dim shp As Shape, Zoomperc As Double, ScrollRij As Long, Scrollkolom As Integer, AC As Range, TL As Range
  With ActiveSheet
    Set AC = ActiveCell                                    'huidige cel
    ScrollRij = Application.ActiveWindow.ScrollRow         'rij van cel bovenaan links
    Scrollkolom = Application.ActiveWindow.ScrollColumn    'kolom van cel bovenaan links
    Set TL = Cells(ScrollRij, Scrollkolom)                 'cel linksboven van dit scherm
    With Application
      .ScreenUpdating = False                              'scherm bevriezen
      .EnableEvents = False                                'events uitschakelen
    End With
    Zoomperc = ActiveWindow.Zoom                           'huidig zoompercentage
    If Zoomperc <> 100 Then ActiveWindow.Zoom = 100        'zet zoom op 100

    MaakShape "Draadkruis_Horizontaal"                     'kijk of horizontaal draadkruis bestaat, zoniet aanmaken
    With .Shapes("Draadkruis_Horizontaal")                 'aanpassen horizontaal draadkruis
      .Visible = True
      .Select
      With Selection.ShapeRange
       [COLOR="black"][COLOR="red"][B] .Left = 0                                          'TL.Left                                    'links=links van toplinks-cel
        .Width = AC.Left                                   ' - TL.Left                         'ruim kiezen voor het geval je zou zoomen naar bv 25[/B][/COLOR][/COLOR]%
        .Top = ActiveCell.Top                              'top=top van huidige cel
        .Height = ActiveCell.Height                        'hoogte=hoogte huidige cel
      End With
    End With