Kleuren in snipperkaart met VBA

[anstof]

Ik heb onlangs een snipperkaart gemaakt met twee tabbladen 'Invoertijden' en 'Resultaat'. Door de hulp van dit forum en iemand die mij een VBA formule gaf lukt het nu om de gegevens die ik invul in uren op het tabblad 'Invoertijden', dit automatisch ook te zien is in het tabblad 'Resultaat' maar dan in decimalen zoals ook de bedoeling was. Dit werkt perfect. Het probleem is nu nog dat de kleuren van de cellen in 'Invoertijden' niet hetzelfde zijn (of worden) als in 'Resultaat'. Ik ben al een tijdje aan het puzzelen en op internet gaan zoeken maar ik weet niet hoe ik dat nu voor elkaar moet krijgen. Weet iemand raad? kan ik eventueel de kleurencode veranderen in deze formule:

Sub Kleuren_Vullen()
Application.ScreenUpdating = False
With Sheets("Resultaat")
.Range("B4:Y34").Value = ""
For Each cl In .Range("B4:Y34")
A = cl.Address
B = Sheets("Invoertijden").Range(A).Value * 24
Kleur = Sheets("Invoertijden").Range(A).Interior.ColorIndex
.Range(A).Interior.ColorIndex = Kleur
If B = 0 Then
.Range(A).Value = ""
Else
.Range(A).Interior.ColorIndex = 20
.Range(A).Value = B
End If
Next
End With
Application.ScreenUpdating = True
End Sub
'Range("A1").Interior.ColorIndex = 3

Bekijk bijlage Snipperkaart 2018 VB (test01).xlsm

 

[SjonR]

zo?

Sub Kleuren_Vullen()
Application.ScreenUpdating = False
With Sheets("Resultaat")
    For i = 2 To 25
        For j = 4 To 34
            .Cells(j, i).Interior.Color = Sheets("Invoertijden").Cells(j, i).Interior.Color
        Next
    Next
End With
Application.ScreenUpdating = True
End Sub

of zo?

Sub Kleuren_Vullen()
Sheets("Invoertijden").Range("B4:Y34").Copy
Sheets("Resultaat").Range("B4:Y34").PasteSpecial xlPasteFormats
End Sub

 

[anstof]

Dit ziet er al veel beter uit.
Alleen in beide codes werken nu de gegevens niet meer. Als ik nu bij 'Invoer" de tijd invul krijg ik bij 'Resultaat' niet meer de tijd in decimalen te zien. In in beide tabbladen krijgen de cellen nu a het invoeren van gegevens wel de juiste kleur, bij de eerste code (snipperkaart 2018 VB test02) is kleur oranje niet exact hetzelfde maar bij de tweede code (snipperkaart 2018 VB test03) wel.

Moet ik de code van jou nu tussen de code plaatsen van 'snipperkaart 2018 VB test01' om het complete plaatje te krijgen?

Bekijk bijlage Snipperkaart 2018 VB (test01).xlsm
Bekijk bijlage Snipperkaart 2018 VB (test02).xlsm
Bekijk bijlage Snipperkaart 2018 VB (test03).xlsm

 

[VenA]

Plaats code tussen codetags. Waarom niet gewoon met formules en dezelfde voorwaardelijk opmaak op beide tabjes?

Sub Kleuren_Vullen()
  Sheets("Invoertijden").Range("B4:Y34").Copy
  With Sheets("Resultaat").Range("B4:Y34")
    .PasteSpecial xlPasteFormats
    .NumberFormat = "0.00"
    ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = .Parent.Cells(1).CurrentRegion
      For j = 4 To UBound(ar) - 1
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).CurrentRegion = ar1
  End With
End Sub

 

[anstof]

Met voorwaardelijke opmaak krijg ik niet datgene wat ik wil. Het tabblad 'Invoer' is alleen bedoeld om de gegevens in te vullen en dat hoef ik dan maar één keer te doen om de uitkomst te zien in 'Resultaat' en ik krijg dat met voorwaardelijke opmaak niet voor elkaar.

Overigens de kleuren werken nu prima en ook de gegevens neemt hij over. Maar als ik nu een fout maak bij een bepaalde cel in 'Invoertijden' en ik haal de gegevens hier weer uit dan laat de cel in 'Resultaat' de gegevens gewoon staan wat eigenlijk niet zou moeten. Bij alleen de kleur veranderen doet hij dat wel, als ik in 'Invoertijden' een cel 'n kleur geef dan krijgt dezelfde cel in 'Resultaat' ook die kleur en als ik dan diezelfde kleur weer weghaal in 'Invoertijden' gaat hij ook weg bij 'Resultaat'. Als er gegevens in de cel staan doet hij dat dus niet.

Ook kleuren al de cellen in 'Resultaat' iedere keer naar een heel licht grijze kleur als ik overga van het tabblad 'Invoertijden' naar 'Resultaat'

Bekijk bijlage Snipperkaart 2018 VB (test04).xlsm

 

[VenA]

Sub Kleuren_Vullen()
  Sheets("Invoertijden").Range("B4:Y34").Copy
  With Sheets("Resultaat").Range("B4:Y34")
    .PasteSpecial xlPasteFormats
    .NumberFormat = "0.00"
    .ClearContents
    ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = .Parent.Cells(1).CurrentRegion
      For j = 4 To UBound(ar) - 1
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).CurrentRegion = ar1
  End With
End Sub

 

[anstof]

Dat is hem. Dank je wel.

Zoals ik kan zien is er alleen dit aan toegevoegd .ClearContents

Dat ene laatste puntje is er nog, dat het gebied B4:Y34 lichtgrijs gaat worden telkens als je van 'Invoertijden' naar 'Resultaat' gaat. Het lijkt erop alsof je selecteert, maar als je op een cel klit is heel het gebied weer normaal. Zou dit nog aan de code kunnen liggen?

Toch heel erg bedankt alvast

 

[VenA]

Welke inspanningen doe je zoal zelf?

Sub Kleuren_Vullen()
  Sheets("Invoertijden").Range("B4:Y34").Copy
  With Sheets("Resultaat").Range("B4:Y34")
    .PasteSpecial xlPasteFormats
    .NumberFormat = "0.00"
    [COLOR="#FF0000"].Cells(1).Select[/COLOR]
    ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = .Parent.Cells(1).CurrentRegion
      For j = 4 To UBound(ar) - 1
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).CurrentRegion = ar1
  End With
End Sub

 

[anstof]

Met Visual Basic kan ik nog zeer weinig, het is bij toeval dat ik via helpmij met de snipperkaart kwam en iemand opperde om dit met VB te doen. Maar eerlijk gezegd weet ik hier echt te weinig van. Ik ben al een paar weken aan het zoeken op internet maar het is een beetje te ingewikkeld voor mij. Soms speel ik wat met de code en dan gaat het vaak mis maar zoals nu heb ik jouw laatste stukje .Cells(1).Select onder dit stukje .ClearContents gezet en nu is dat grijze gedeelte dus weg.
Ik heb heel lang geleden wel eens een website gemaakt in HTML code maar dat is toch nog wat anders. Deze snipperkaart was voor mij belangrijk en als ik nu zie wat je allemaal kunt doen met VB lijkt het me wel leuk om wat meer te leren.

Thanks