Extra knop in module

[Sacruzsa]

Hallo iedereen,

Kan iemand mij helpen met volgende probleem ?
Ik wil namelijk graag een extra knop toevoegen aan een module, met de functie ga naar vandaag, is dat mogelijk?
De code in de module is nu :

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date ##/##/2024 format")
If IsDate(TheString) Then
    TheDate = DateValue(TheString)
Else
    MsgBox "Invalid date enter ##/##/2024 format"
     Exit Sub
End If

Inarr = Range(Cells(11, 1), Cells(11, 750))
tt = TheDate
For i = 1 To 750
If tt = Inarr(1, i) Then
 Cells(11, i).Select
 Exit For
End If
Next i

End Sub

en ziet er zo uit :


Zou dus graag links van de knop 'OK' een knop 'Today' hebben indien mogelijk
is het ook mogelijk om, als ik op 'cancel' druk niet een error code maar gewoon dat het scherm verdwijnt, nu verschijnt er telkens dit :

Maar dit zou enkel moeten verschijnen als ze een foute datum ingeven.
De Excel vind u in bijlage

Alvast bedankt voor de hulp

 

[Haije]

Dit lost je laatste probleem op:

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date ##/##/2024 format")
If TheString = False Then Exit Sub
    If IsDate(TheString) Then
        TheDate = DateValue(TheString)
    Else
        MsgBox "Invalid date enter ##/##/2024 format"
    Exit Sub
    End If

Inarr = Range(Cells(11, 1), Cells(11, 750))
tt = TheDate
For i = 1 To 750
If tt = Inarr(1, i) Then
 Cells(11, i).Select
 Exit For
End If
Next i

End Sub

 

[snb]

Verwijder alle samengevoegde cellen
Verwijder alle vertragende plaatjes.
Beperk de kalender tot een maand.
vervang kolom A t/m N door 1 kolom met de titel 'aktiviteit' Daarin kan dan een van de opties met een validaitelijst gekozen worden.

 

[snb]

Verwijder alle samengevoegde cellen
Verwijder alle vertragende plaatjes.
Beperk de kalender tot een maand.
vervang kolom A t/m N door 1 kolom met de titel 'aktiviteit' Daarin kan dan een van de opties met een validaitelijst gekozen worden.
Reduceer het aantal voorwaardelijke opmaakregels: het zijn er veelteveel.

Hiermee ga je altijd naar vandaag :

Private sub Workbook.open()
   application.goto cells(13.20+format(date,"y"))
End Sub

 

[Sacruzsa]

Dit lost je laatste probleem op:

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date ##/##/2024 format")
If TheString = False Then Exit Sub
    If IsDate(TheString) Then
        TheDate = DateValue(TheString)
    Else
        MsgBox "Invalid date enter ##/##/2024 format"
    Exit Sub
    End If

Inarr = Range(Cells(11, 1), Cells(11, 750))
tt = TheDate
For i = 1 To 750
If tt = Inarr(1, i) Then
 Cells(11, i).Select
 Exit For
End If
Next i

End Sub

Met deze krijg is Run-time error '13'

 

[Haije]

Wanneer krijg je dit?

 

[AHulpje]

Zo ga je naar vandaag:

    Application.Goto Sheets("Sitpers 2024").Range("A11:ABW11").Find(Date), False

 

[edmoor]

Met deze krijg is Run-time error '13'
Bekijk bijlage 375275

Je neemt een String in en controleert op een Boolean (False).
Dat veroorzaakt die fout 13.

 

[OctaFish]

En de oplossing hiervoor is dus:

If TheString = “” Then Exit Sub

 

[AHulpje]

Met een userform is het een stuk eenvoudiger.