Kalender invoegen 2

[Ron321]

Lezende in dit topic werd ik op een idee gebracht.

Ik heb het geprobeerd toe te passen in mijn bestand maar het verschil is dat ik al een formule heb staan in de desbetreffende cel.

Bij een bepaalde voorwaarde komt er een datum in die cel en anders blijft die cel leeg en moet er zelf een datum ingevuld worden.

Alleen als ik nu dubbelklik op de cel kom ik in de formule terecht.

Is het ook mogelijk dat de kalender tevoorschijn komt als ik alleen al de cel selecteer?

En hoe bewerk ik onderstaande code zodat het voor 2 verschillende cellen op hetzelfde blad werkt?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$E$1" Then

UserForm1.Show
End If
End Sub

 

[trucker10]

Beste Ron321 , het is voor de helpers wat gok werk een voorbeeldje zou veel beter zijn om je vraag af te werken . ik heb een persoonlijk bestandje waar ik de cel(len) selecteer en de kalender tevoorschijn komt dan ziet de code er zo uit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("c13:c15 , g13:g15"), Target) Is Nothing Then
        Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
        Calendar1.Top = Target.Top + Target.Height
        Calendar1.Visible = True
        Calendar1.Value = Date
    ElseIf Calendar1.Visible Then Calendar1.Visible = False
    End If
    
End Sub

ook heb ik mijn kalender een format gegeven dat hij de datum juist wegschrijft dat met deze code

Private Sub Calendar1_Click()
ActiveSheet.Unprotect Password:=""
    ActiveCell.Value = CDbl(Calendar1.Value)
    ActiveCell.NumberFormat = "dd/mm/yyyy"
    ActiveCell.Select
    Calendar1.Visible = False
ActiveSheet.Protect Password:=""
End Sub

Bekijk het zelf of je jouw bestandje kan uploaden .

 

[Ron321]

En hoe bewerk ik onderstaande code zodat het voor 2 verschillende cellen op hetzelfde blad werkt?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$E$1" Then

UserForm1.Show
End If
End Sub

Allereerst bedankt voor je reactie.

Het eerste gedeelte is opgelost.

Nu wil ik het alleen voor 2 cellen laten werken zie vb B1 en C1.

 

[danny147]

Beste Ron321

Zet de volgende code in BLAD1 van VBA - Editor

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B1:C1")) Is Nothing Then
Userform1.Show
Target.Offset(0, 1).Select
End If
End Sub

Groetjes Danny. :thumb:

 

[trucker10]

Ron321 , mijn voorbeeldje zonder userform met kalender
Edit : als je per toeval in B1 klikt en je wil daar de datum niet wijzigen klik dan ergens anders dubbel en de kalender gaat weg

 

[Ron321]

Bedankt, het werkt iig in het voorbeeldbestandje, nu nog proberen in het origineel.
Ik heb alleen

Target.Offset(0, 1).Select

weggelaten.:thumb:

 

[Ron321]

Ron321 , mijn voorbeeldje zonder userform met kalender
Edit : als je per toeval in B1 klikt en je wil daar de datum niet wijzigen klik dan ergens anders dubbel en de kalender gaat weg

Hmmm, dat is ook een mooie oplossing, zal ik ook eens proberen, bedankt:thumb:

 

[Ron321]

Ron321 , mijn voorbeeldje zonder userform met kalender
Edit : als je per toeval in B1 klikt en je wil daar de datum niet wijzigen klik dan ergens anders dubbel en de kalender gaat weg

Hoi Daniël, hoe pas ik onderstaand stukje aan als de cellen niet naast elkaar liggen maar bijv. L56 en L58 moeten zijn?

If Not Application.Intersect(Range("B1:C1"), Target) Is Nothing Then

 

[Ron321]

Nou, ik hou het toch maar bij het userform want die werkt goed.
Bij die andere krijg ik weer een foutmelding.

Bedankt allemaal voor de moeite:thumb:

 

[trucker10]

Hoi Daniël, hoe pas ik onderstaand stukje aan als de cellen niet naast elkaar liggen maar bijv. L56 en L58 moeten zijn?

If Not Application.Intersect(Range("B1:C1"), Target) Is Nothing Then

Bij deze

 

[Ron321]

Thx,:thumb: