Ga naar inhoud

Aanpassing Private Sub met datum-tijd


Cor-Assa
 Delen

Aanbevolen berichten

Private Sub Cmb_00_Click()
If Cmb_00.Caption = "" Then
    ActiveCell.Interior.Color = RGB(255, 0, 0)
    ActiveCell.Value = "In Storing"
End If
If Cmb_00.Caption = "In Storing" Then
    ActiveCell.Interior.Color = RGB(164, 208, 80)
    ActiveCell.Value = ""
End If
Unload Me
End Sub

Beste mensen, ik wil een aanpassing in de programmering hierboven die voor mij gemaakt is.

Het gaat om het volgende;

     In cel A1 op hetzelfde werkblad staat een datum en tijd die bij activering van deze Sub geupdate moet worden naar de actuele tijd.

     De celwaarde is '=NU()'.

     Daarna moet deze datum en tijd in de plaats komen van "In Storing" die in de 4e regel staat.

     De datum moet wel in 'Arial Narrow - 8' zijn.

Ik heb al meerdere pogingen gedaan maar krijg het niet voor elkaar.

Link naar reactie
Delen op andere sites


2 minuten geleden, dotchiejack zei:

Cor wat meer duidelijkheid.

Deze code staat in de userform die je gebruikt op verschillende bladen om elementen in en uit storing te zetten.

De enigste =NU() is te vinden op je werkblad Storings overzicht RWS in cel R4

Klopt dotchiejack.

Ik heb van de collega's het verzoek gekregen om de datum en tijd van in storing melding te vermelden.

de makkelijkste oplossing lijkt mij om de melding "In storing" daarvoor te wijzigen.

Daarom wil ik op ieder formulier in cel A1 die vrij is de datum vermelden.

Maar omdat de tijd niet automatisch mee loopt bij activering een update.

Hoop dat het je zo duidelijk genoeg is?

 

Alvast bedankt, Cor

Link naar reactie
Delen op andere sites


Probeer het eens zo.

Zeker niet nodig om overal NU onder A1 te gaan plakken in al je bladen.

Gewoon uit de cel .R4 halen van je werkblad Storings overzicht RWS

 

Private Sub Cmb_00_Click()
With ActiveCell.Font
.Name = "Arialnarow"
.Size = 8
End With
If Cmb_00.Caption = "" Then
    ActiveCell.Interior.Color = RGB(255, 0, 0)
    ActiveCell.NumberFormat = "m/d/yyyy h:mm"
    Calculate
    ActiveCell.Value = Sheets("Storings overzicht RWS").Range("R4")
End If
If Cmb_00.Caption = "In Storing" Then
    ActiveCell.Interior.Color = RGB(164, 208, 80)
    ActiveCell.Value = ""
End If
Unload Me
End Sub

 

aangepast door dotchiejack
Code aangepast naar datum en tijd,had er eerst overgelezen
Link naar reactie
Delen op andere sites

38 minuten geleden, dotchiejack zei:

Probeer het eens zo.

Zeker niet nodig om overal NU onder A1 te gaan plakken in al je bladen.

Gewoon uit de cel .R4 halen van je werkblad Storings overzicht RWS

 

Private Sub Cmb_00_Click()
With ActiveCell.Font
.Name = "Arialnarow"
.Size = 8
End With
If Cmb_00.Caption = "" Then
    ActiveCell.Interior.Color = RGB(255, 0, 0)
    ActiveCell.NumberFormat = "m/d/yyyy h:mm"
    Calculate
    ActiveCell.Value = Sheets("Storings overzicht RWS").Range("R4")
End If
If Cmb_00.Caption = "In Storing" Then
    ActiveCell.Interior.Color = RGB(164, 208, 80)
    ActiveCell.Value = ""
End If
Unload Me
End Sub

 

Tot zover werkt het.

Maar ik neem aan dat de 2e If regel dan zo moet zijn;

If Cmb_00.Caption <> "" Then

 

Dan kom ik bij de volgende stap de filters voor het overzichts veld "Storings overzicht RWS".

Dat filter werkt niet meer omdat naar de tekst "In storing" gezocht wordt en daar staan nu verschillende data en tijden in?

Weet je daar ook een oplossing voor dotchiejack? Jij vast wel. 😊

Link naar reactie
Delen op andere sites

Klopt wat betreft 2 de If regel. Ik had er verder niet bij stilgestaan. Mijn aandacht zat bij een ander Excel bestand.

Wat het filteren betreft, ik moest eventjes zoeken met al je verborgen toestanden.

Zet een S bij de datum en uur en filter op de letter S

 

Private Sub Cmb_00_Click()
With ActiveCell.Font
.Name = "Arialnarow"
.Size = 8
End With
If Cmb_00.Caption = "" Then
    ActiveCell.Interior.Color = RGB(255, 0, 0)
    ActiveCell.Value = "S "
    ActiveCell.NumberFormat = "m/d/yyyy h:mm"
    Calculate
    ActiveCell.Value = ActiveCell.Value & Sheets("Storings overzicht RWS").Range("R4")
End If
If Cmb_00.Caption <> "" Then
    ActiveCell.Interior.Color = RGB(164, 208, 80)
    ActiveCell.Value = ""
End If
Unload Me
End Sub

 

Link naar reactie
Delen op andere sites


 Delen

×
×
  • Nieuwe aanmaken...