textbox achtergrondkleur laten knipperen

Status
Niet open voor verdere reacties.
M

maurits60

Gebruiker
Lid geworden
22 jan 2016
Berichten
5
Hallo,

Ik wil graag 6 textboxen koppelen met enkele cellen.

Ik heb een schoolontwerp voor een verwarmingsinstallatie in excel gemaakt. In een keuzemenu (linksboven, eerste blad) kan met de hand de buitentemperatuur worden ingesteld. Voor het opleuken van de komende presentatie wil ik de 3 verwarmingselementen en 3 koelelementen in kleur laten pulsen op de wisselende kW's die er doorheen gestuurd worden.

Onderstaande code laat een cel rood knipperen. Dat uitgangspunt hoopte ik op eigen kracht een beetje te kunnen tweeken. Ik heb de 'Sheet1' veranderd in mijn 'P&ID' range veranderd van 'E9' naar mijn 'TextBox 50'. Maar het werkt niet.

Ik kom in mijn zoektocht veel verschillende codevoorbeelden tegen. En ik krijg de indruk dat ik geen activeX of userform nodig heb voor wat ik wil. Op welke manieren kan ik cellen van het 2e blad koppelen aan de achtergrondkleur van mijn textboxen op het eerste blad?


mvg maurits

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Sub ColorChange()
'On Error Resume Next
Application.DisplayAlerts = False
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Set Rng = ws.Range("E9")
Application.ScreenUpdating = False
If Rng.Interior.ColorIndex = 3 Then
Rng.Interior.ColorIndex = 0
Else: Rng.Interior.ColorIndex = 3
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Update_Time
End Sub

Sub Update_Time()
Application.OnTime Now() + TimeValue("00:00:02"), "ColorChange"
End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Sub ColourBox()

ActiveSheet.Shapes("TextBox 50").Select
With Selection.Font
.ColorIndex = 32 'change to colour you want
End With
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 54 'change to colour you want

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
 

Bijlagen

Laatst bewerkt:
Hoi,
Welkom op dit forum:)
Plaats in het vervolg uw code tussen codetags, zoals hier
Code: 
'Hier uw code

Helpt dit u verder?
In bijlage uw bestandje aangepast
Groet
 

Bijlagen

Super! De presentatie van deze opdracht is 3 februari, maar ik moet ook buffelen voor een tentamen op diezelfde dag. Maar deze nieuwe code is een goede start om zelfstandig verder te klunen naar een passend eindresultaat. Ik ga de komende 2 weken aan de slag hiermee.

Bedankt hoor!
 
@dotchie: lees de regels eens na over schoolopdrachten. Het is zeker niet de bedoeling dat helpers complete oplossingen aanrijken.
 
Weest niet bevreesd. De kleuren nog aanpassen is niet zo spannend idd. Maar ik wil het door de radiators stromende vermogen verbeelden in de knipperfrequenties. Dat is nog enig zoekwerk voor mij als VBA-newbee.
 
Hoi Maurits,
Ander vbtje,
De rest moet je zelf maar uitvissen
RGB codes genoeg via google
Verander eens de waarde in C4 en zie wat er gebeurt in textbox50
Groet
 

Bijlagen

@ octafisch , is er ergens een regelment voor voorddurend te lopen zeiken tegen een ander lid?
Ik wordt er in iedergeval moe van
 
gast0660 zei:
@ octafisch , is er ergens een regelment voor voorddurend te lopen zeiken tegen een ander lid?
Klik om te vergroten...
Gelukkig niet; zeker niet als anderen zich niet aan de regels houden :). Maar bekijk het eens van de andere kant: alle helpers die zich wél aan de regels houden, en schoolopdrachten dus níet kant en klaar aanleveren. Jij maait ze in één klap alle gras onder de voeten weg, en de TS leert er ook geen klap van. Het is juist de bedoeling om de TS in de juiste richting duwen zodat hij/zij er optimaal van leert. En dát is exact de reden dat we bij schoolwerk géén kant-en-klare oplossingen aanleveren.
Overigens kan ik ook de moderator waarschuwen, dan krijg je van hem/haar een standje. Wat je liever hebt...
 
Hallo again,

De bijbehorende presentatie op school is een weekje uitgesteld. Dat geeft mij nog wat extra tijd. Die ik hard nodig heb, want makkelijk is het niet dat code schrijven.

Ik heb veel gespeurd op het net en vond oa. de Wijze Uil (ik mag waarschijnlijk geen reklame maken hier) uit Engeland begrijpelijk uitleggen. Ik wil iets fabriceren zoals een lichtbaken langs de kust, langzaam knipperend anders wordt iedereen tureluurs. Een basiskleur dus waar een andere tint van die kleur gedurende een aantal milliseconden overheen wordt gezet. En dan stapt die knipperfrequentie omhoog naar gelang het aantal stappen verwijderd van 20 graden Celsius.

Dit zou moeten kunnen met Wait, Sleep etc, omdat die toepassing van millisekonden toestaan. Maar ik weet niet hoe dit in te voegen in de code die ik tot nu toe heb. Moet ik dan gaan nesten? Ik heb niets kunnen vinden op het net in een richting, waarin ik als leek denk een werkbare code te kunnen schrijven.

In mijn bijgevoegde code ben ik uitgegaan van de voorbeelden van gast0660. En ik heb die aangepast totdat de debugger er niet meer over struikelt. Debugger blijft nu onderaan hangen op "RunWhen". Dat snap ik nog wel omdat ik bovenin eenen ander verwijderd heb. Maar betekent dit dat de voorgaande code dan in principe wel goed is?

Zoja, dan zal de macro nog niet goed werken want de instructies voor de kleuren zijn nog niet zonder fouten. De textboxen worden gecheckt voor witte kleur (9) als vulling waarop de knipperinstructie van gast0660 wordt uitgevoerd. Lees ik dit goed zo? Als 'sleep' een bruikbare optie is voor het pulsen, hoe kan ik die voegen in mijn product-tot-nu-toe?

Ik heb de sheetcode en modulecode bij elkaar geplaatst hieronder.

Bedankt voor de pointers.

vgr maurits



Code: 
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'start sheet code
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Option Explicit

Private Sub Workbook_Open()
    StartPulseColor
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopPulseColor
End Sub


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'start module code
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


Option Explicit

Sub PulseColor()
    
    Dim shpTemp As Shape
    
    Application.ScreenUpdating = False
    
    Worksheets("Gegevens").Activate
    Range("C14").Select
    
    
    'bij warmtevraag staan 3 koudewisselaars statisch op non-actief en 3 warmtewisselaars pulseren (2 tinten rood)
    Do While ActiveCell.Value = "-10"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        With shpTemp.Fill.ForeColor
            If .SchemeColor = 9 Then
                .RGB = RGB(255, 178, 127)
            Else
                .RGB = RGB(255, 127, 42)
            End If
        End With
    
    
    'bij warmtevraag staan 3 koudewisselaars statisch op non-actief en 3 warmtewisselaars pulseren (2 tinten rood)
    Do While ActiveCell.Value = "-5"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        With shpTemp.Fill.ForeColor
            If .SchemeColor = 9 Then
                .RGB = RGB(255, 178, 127)
            Else
                .RGB = RGB(255, 127, 42)
            End If
        End With
    
   
   'bij warmtevraag staan 3 koudewisselaars statisch op non-actief en 3 warmtewisselaars pulseren (2 tinten rood)
   Do While ActiveCell.Value = "0"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        With shpTemp.Fill.ForeColor
            If .SchemeColor = 9 Then
                .RGB = RGB(255, 178, 127)
            Else
                .RGB = RGB(255, 127, 42)
            End If
        End With
    
    
    'bij warmtevraag staan 3 koudewisselaars statisch op non-actief en 3 warmtewisselaars pulseren (2 tinten rood)
    Do While ActiveCell.Value = "5"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        With shpTemp.Fill.ForeColor
            If .SchemeColor = 9 Then
                .RGB = RGB(255, 178, 127)
            Else
                .RGB = RGB(255, 127, 42)
            End If
        End With
    
   'bij warmtevraag staan 3 koudewisselaars statisch op non-actief en 3 warmtewisselaars pulseren (2 tinten rood)
   Do While ActiveCell.Value = "10"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        With shpTemp.Fill.ForeColor
            If .SchemeColor = 9 Then
                .RGB = RGB(255, 178, 127)
            Else
                .RGB = RGB(255, 127, 42)
            End If
        End With
    
   
    'bij warmtevraag staan 3 koudewisselaars statisch op non-actief en 3 warmtewisselaars pulseren (2 tinten rood)
   Do While ActiveCell.Value = "15"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        With shpTemp.Fill.ForeColor
            If .SchemeColor = 9 Then
                .RGB = RGB(255, 178, 127)
            Else
                .RGB = RGB(255, 127, 42)
            End If
        End With
    
    
    'bij 20 graden celsius staan alle 6 wisselaars op non-actief (grijs)
    Do While ActiveCell.Value = "20"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4, TextBox 97, TextBox 96, TextBox 95")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
    
    
    'bij koudevraag staan 3 warmtewisselaars statisch op non-actief en 3 koudewisselaars pulseren (2 tinten blauw)
    Do While ActiveCell.Value = "25"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        With shpTemp.Fill.ForeColor
        If .SchemeColor = 9 Then
            .RGB = RGB(160, 215, 255)
        Else
            .RGB = RGB(118, 169, 255)
        End If
    End With
    
    
    'bij koudevraag staan 3 warmtewisselaars statisch op non-actief en 3 koudewisselaars pulseren (2 tinten blauw)
    Do While ActiveCell.Value = "30"
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 50, TextBox 49, TextBox 4")
        shpTemp.Fill.ForeColor.RGB = RGB(240, 240, 240)
        Set shpTemp = ThisWorkbook.Worksheets("P&ID").Shapes("TextBox 97, TextBox 96, TextBox 95")
        With shpTemp.Fill.ForeColor
        If .SchemeColor = 9 Then
            .RGB = RGB(160, 215, 255)
        Else
            .RGB = RGB(118, 169, 255)
        End If
    End With
    
    Loop
    
    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartPulseColor", , True
    
    Application.ScreenUpdating = True
    
End Sub

Sub StopPulseColor()
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartPulseColor", , False
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan