ขอความช่วยเหลือแก้โค้ด ปฏิทิน

[parakorn]

รบกวนขอความช่วยเหลือแก้ไข ปฏิทิน ที่ E6
ให้ไปทำงานหลังจากคลิ๊ก Shape ด้านข้างทีครับ
โดยให้แสดงเมื่อคลิ๊ก Shape พอกดเลือกวันที่ให้ปฏิทินหายไปครับ
เนื่องจากโค้ดที่แสดงเมื่อคลิ๊ก Cell มันทำให้หน้าจอ Refresh ตลอด
ทำให้โค้ดที่บันทึก Macro ให้ Copy ไม่สามารถทำงานได้เลยครับ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$E$6" Then
    With ActiveSheet.Calendar1
           .Visible = True
            .Top = ActiveCell.Offset(0, 0).Top
            .Left = ActiveCell.Offset(0, 1).Left
    End With
Else
    ActiveSheet.Calendar1.Visible = False
End If
Application.EnableEvents = True
End Sub

[suka]

เพิ่ม Code นี้ต่อจาก Code เดิมลองดูว่าได้ไหมค่ะ

Code: Select all

Private Sub Calendar1_Click()
        ActiveCell.Value = Calendar1.Value
End Sub

[ZEROV]

ที่ Sheet1 มี Calendar1 ถึงสองตัว เอาใว้ทำอะไรครับ

Code: Select all

Private Sub Calendar1_Click()
[e6].Value = Calendar1.Value
Unload Me
End Sub

[parakorn]

ตั้งใจจะลบตัวที่โชว์เมื่อคลิ๊ก Cell แล้วใช้ตัวที่คลิ๊ก Shape แทน
เพราะ Code มัน Refresh Sheet แต่หากสามารถแก้ไขได้อาจจะใช้ตัวเดิมครับ

[parakorn]

เพิ่ม Code นี้ต่อจาก Code เดิมลองดูว่าได้ไหมค่ะ

Code: Select all

Private Sub Calendar1_Click()
        ActiveCell.Value = Calendar1.Value
End Sub

โค้ดนี้เอาไปฝังในปุ่มใช่ไหมครับ

[suka]

ต่อจาก code เดิมค่ะ Calendar Add มาแค่อันเดียวพอค่ะ

ตัวอย่าง Code ใช้ Calendar หลายเซลล์ค่ะ ได้จากกระทู้ถามตอบมาค่ะ ลองปรับใช้ดูนะคะ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = "$B$1" Or Target.Address = "$D$1" Or _
        Target.Address = "$G$4" Or Target.Address = "$G$5" Or Target.Address = "$G$6" Or _
        Target.Address = "$G$7" Or Target.Address = "$G$8" Or Target.Address = "$G$9" Or Target.Address = "$G$10") Then
    With ActiveSheet.Calendar1
            .Visible = True
            .Top = ActiveCell.Offset(0, 0).Top
            .Left = ActiveCell.Offset(0, 1).Left
             If Target.Value <> "" Then
                    .Value = Target.Value
            End If
    End With
Else
        ActiveSheet.Calendar1.Visible = False
End If
        Application.EnableEvents = True
End Sub
Private Sub Calendar1_Click()
        ActiveCell.Value = Calendar1.Value
End Sub

[parakorn]

แก้ไขได้แล้วครับ ขอบคุณสำหรับคำแนะนำต่างๆครับผม