:!: โปรดทราบ Image
    1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ดครับ Image
    2. การสมัครสมาชิกเพื่อโพสต์คำถาม ดาวน์โหลดไฟล์แนบไปศึกษา ทำตามขั้นตอนด้านล่างครับ
      1. สมัครสมาชิก ดูขั้นตอนตาม Link นี้ครับ => สมัครสมาชิก กรณีลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่นี่ครับ => Reset รหัสผ่านImage
      2. Login เข้าระบบโดยคลิก Login ตรงมุมขวาบนของหน้านี้ Image กรณีมีปัญหาในการเข้าใช้งาน คลิก Link นี้เพื่อแจ้งผู้ดูแลระบบครับ => ติดต่อผู้ดูแลระบบ
    3. เมื่อ Login แล้วสามารถกำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษได้ที่ Link นี้ครับ => ตั้งค่าส่วนตัว Image
    4. วิธีการตั้งและตอบกระทู้ดูได้ที่ Link นี้ครับ => วิธีการตั้งและตอบกระทู้ Image
    5. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ Link นี้ครับ => จัดรูปแบบตัวอักษร และสามารถกำหนดขนาดตัวอักษรใน Browser ได้ที่นี่ครับ ==> กำหนดขนาดตัวอักษรใน Browser Image

รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

ฟอรั่มถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถาม-ตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบ ต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. อธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. ควรแนบตัวอย่างไฟล์มาที่ฟอรั่มนี้เพื่อเพิ่มความสะดวกในการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่น นอกจากนี้ไม่ควรแนบไฟลที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. สำหรับคำถามเกี่ยวกับ VBA ให้ลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน ควรโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. แจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#1

Postby sooksun2009 » Thu Nov 23, 2017 1:38 pm

ต้องการคลิก CommandButton39 แล้วให้ TextBox4 แสดง ตามcell ฺB5,TextBox8 แสดง ตามcell ฺB5,
TextBox7 แสดง ตามcell ฺC5,TextBox5 แสดง ตามcell ฺD5,TextBox6 แสดง ตามcell ฺE5,label60 แสดง ตามcell ฺF5,และกดปุม start ให้ TextBox4 countdown และ กดปุ่ม stop ให้TextBox4 หยุด countdown ขอบคุณครับ

Code: Select all

Private Sub CommandButton39_Click()
On Error GoTo ErrorHandler

With TextBox4
    .Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
TextBox4.Value = Sheet2.Range("B5").Value
End With
With TextBox8
TextBox8.Value = Sheet2.Range("B5").Value
End With
With TextBox5
TextBox5.Value = Sheet2.Range("D5").Value
End With
With TextBox6
TextBox6.Value = Sheet2.Range("E5").Value
End With
With TextBox7
TextBox7.Value = Sheet2.Range("C5").Value
End With
End Sub


Private Sub CommandButton37_Click()
On Error GoTo ErrorHandler

With TextBox3
    .Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
    .Value = Format(TimeValue(Now), "hh:mm:ss")
End With
End Sub
Private Sub CommandButton38_Click()
On Error GoTo ErrorHandler

With TextBox2
    .Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
    .Value = Format(TimeValue(Now), "hh:mm:ss")
End With
End Sub


'Private Sub TextBox4_Change()
Sub startTimer()
Application.OnTime Now + TimeValue("00:00:01"), "nextTick"
End Sub

'Macro for next second
Sub nextTick()
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
startTimer
End Sub

'Macro for stopping the timer (attached to the end button)
Sub stopTimer()
Application.OnTime Now - TimeValue("00:00:01"), "nextTick", , False
End Sub
You do not have the required permissions to view the files attached to this post.

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#2

Postby sooksun2009 » Fri Nov 24, 2017 8:07 am

ไม่มีใครช่วยได้เลย

User avatar
snasui
Site Admin
Site Admin
Posts: 22375
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#3

Postby snasui » Fri Nov 24, 2017 5:15 pm

sooksun2009 wrote:ไม่มีใครช่วยได้เลย

:D ช่วงนี้ผมยังไม่สะดวกเข้ามาตอบครับ

ที่เขียนมาเองแล้วนั้น ปัจจุบันติดปัญหาตรงไหน อย่างไร ค่อย ๆ ถามตอบกันไป ทำให้ผ่านไปทีละขั้นครับ

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#4

Postby sooksun2009 » Mon Nov 27, 2017 8:25 am

textbox ให้แสดงเป็น hh:mm:ss ครับ

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#5

Postby sooksun2009 » Mon Nov 27, 2017 9:52 am

snasui wrote:
sooksun2009 wrote:ไม่มีใครช่วยได้เลย

:D ช่วงนี้ผมยังไม่สะดวกเข้ามาตอบครับ

ที่เขียนมาเองแล้วนั้น ปัจจุบันติดปัญหาตรงไหน อย่างไร ค่อย ๆ ถามตอบกันไป ทำให้ผ่านไปทีละขั้นครับ

อยาก Textbox 4 รับค่าจาก จาก sheet5 cell B2 แล้วให้ Format เป็น hh:mm:ss ครับ ขอบคุณครับ

Code: Select all

Private Sub ComboBox2_Change()
Sheet5.Range("A2").Value = ComboBox2.Value
Label60.Caption = Sheet5.Range("F2").Value
Label131.Caption = ComboBox2.Value
With TextBox4
On Error GoTo ErrorHandler
TextBox4.Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
TextBox4.Value = Sheet5.Range("B2").Value

End With
With TextBox8
TextBox8.Value = Sheet5.Range("B2").Value
End With
With TextBox5
TextBox5.Value = Sheet5.Range("D2").Value
End With
With TextBox6
TextBox6.Value = Sheet5.Range("E2").Value
End With
With TextBox7
TextBox7.Value = Sheet5.Range("C2").Value

End With
End Sub
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22375
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#6

Postby snasui » Wed Nov 29, 2017 6:46 am

:D ตัวอย่าง Code ครับ

Code: Select all

Private Sub ComboBox2_Change()
    Sheet5.Range("A2").Value = ComboBox2.Value
    Label60.Caption = Sheet5.Range("F2").Value
    Label131.Caption = ComboBox2.Value
    With TextBox4
        .Value = Format(Sheet5.Range("B2").Value, "h:mm:ss")
    End With
'Other code

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#7

Postby sooksun2009 » Thu Nov 30, 2017 2:52 pm

snasui wrote::D ตัวอย่าง Code ครับ

Code: Select all

Private Sub ComboBox2_Change()
    Sheet5.Range("A2").Value = ComboBox2.Value
    Label60.Caption = Sheet5.Range("F2").Value
    Label131.Caption = ComboBox2.Value
    With TextBox4
        .Value = Format(Sheet5.Range("B2").Value, "h:mm:ss")
    End With
'Other code
ขอบคุณอาจารย์มากครับ มีคำถามเพิ่มครับ อยากกดปุ่ม start แล้วให้ TextBox4 นัยถอยหลังครับ

Code: Select all

Private Sub CommandButton38_Click()
starttimer1
TextBox4.Value = Sheet5.Range("G2").Value
With TextBox4
.Value = Format(Sheet5.Range("G2").Value, "h:mm:ss")
End With
End Sub
Sub starttimer1()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick1"
End Sub
Sub nexttick1()
    If Sheet5.Range("G2") = 0 Then Exit Sub
        Sheet5.Range("G2").Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
    starttimer1
    If TextBox4 = 0 Then Exit Sub
           TextBox4.Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
    starttimer1
    If Sheet5.Range("G2").Value < TimeValue("00:01:00") Then Beep
End Sub
Sub stopTimer1()
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "nexttick1", , False
End Sub
You do not have the required permissions to view the files attached to this post.

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#8

Postby sooksun2009 » Thu Nov 30, 2017 2:53 pm

TextBox4 นับถอยหลังครับ

User avatar
snasui
Site Admin
Site Admin
Posts: 22375
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#9

Postby snasui » Fri Dec 01, 2017 7:15 am

:D ตัวอย่างการปรับ Code ครับ

เพิ่ม Event Change ไปที่ Sheet Dynamic ตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "G2" Then
        With UserForm1.TextBox4
            .Value = Format(Range("g2").Value, "h:mm:ss")
        End With
    End If
End Sub


ปรับ nexttick1 เป็นตามด้านล่างครับ

Code: Select all

Sub nexttick1()
    If Sheet5.Range("G2") = 0 Then Exit Sub
    Sheet5.Range("G2").Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
'    If TextBox4 = 0 Then Exit Sub
'    TextBox4.Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
    If Sheet5.Range("G2").Value < TimeValue("00:01:00") Then Beep
    starttimer1
End Sub

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#10

Postby sooksun2009 » Fri Dec 01, 2017 8:06 am

snasui wrote::D ตัวอย่างการปรับ Code ครับ

เพิ่ม Event Change ไปที่ Sheet Dynamic ตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "G2" Then
        With UserForm1.TextBox4
            .Value = Format(Range("g2").Value, "h:mm:ss")
        End With
    End If
End Sub


ปรับ nexttick1 เป็นตามด้านล่างครับ

Code: Select all

Sub nexttick1()
    If Sheet5.Range("G2") = 0 Then Exit Sub
    Sheet5.Range("G2").Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
'    If TextBox4 = 0 Then Exit Sub
'    TextBox4.Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
    If Sheet5.Range("G2").Value < TimeValue("00:01:00") Then Beep
    starttimer1
End Sub

ขอบคุณครับอาจารย์ แต่ติดปัญหาอยู่นิดหนึ่งครับ เวลาผมกดปุ่ม Save ติด Bug ครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "G2" Then
        With UserForm1.TextBox4
            .Value = Format(Range("g2").Value, "h:mm:ss")
        End With
    End If
End Sub

save code

Code: Select all

Private Sub CommandButton36_Click()
Sheet3.Activate
Dim irow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Save")
    'find first empty row in database
    irow = ws.Cells(Rows.Count, 2) _
        .End(xlUp).Offset(1, 0).Row
    'Check for Id
    If Trim(Me.ComboBox2.Value) = "" Then
        Me.ComboBox2.SetFocus
        MsgBox "a~E^e`^(a)?e`I'E^O^^(1)?e'O`"
        Exit Sub
    End If
    'copy the data to the database
    ws.Cells(irow, 1).Value = Me.ComboBox2.Value
    ws.Cells(irow, 2).Value = Me.TextBox1.Value
    ws.Cells(irow, 3).Value = Me.TextBox2.Value
    ws.Cells(irow, 4).Value = Me.TextBox3.Value
    ws.Cells(irow, 5).Value = Me.TextBox4.Value
    ws.Cells(irow, 6).Value = Me.TextBox8.Value
    ws.Cells(irow, 7).Value = Me.TextBox7.Value
    ws.Cells(irow, 8).Value = Me.TextBox5.Value
    ws.Cells(irow, 9).Value = Me.TextBox6.Value
    'Clear the data
    Me.ComboBox2.Value = ""
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.TextBox8.Value = ""
    Me.TextBox7.Value = ""
    Me.TextBox6.Value = ""
    Me.TextBox5.Value = ""
    ActiveWorkbook.Save
End Sub

User avatar
snasui
Site Admin
Site Admin
Posts: 22375
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#11

Postby snasui » Sun Dec 03, 2017 4:44 pm

:D แนบไฟล์ล่าสุดที่ได้ Update Code ตามด้านบนมาแล้วด้วย เพื่อจะได้สะดวกในการทดสอบครับ

sooksun2009
Member
Member
Posts: 63
Joined: Fri Sep 18, 2015 3:21 pm

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#12

Postby sooksun2009 » Tue Dec 05, 2017 8:33 am

snasui wrote::D แนบไฟล์ล่าสุดที่ได้ Update Code ตามด้านบนมาแล้วด้วย เพื่อจะได้สะดวกในการทดสอบครับ
ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 22375
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

#13

Postby snasui » Wed Dec 06, 2017 7:29 am

:D ที่ปุ่ม Save ให้ยกเลิกการ Enable Event และกำหนดใหม่ตามตัวอย่างด้านล่างครับ

Code: Select all

Private Sub CommandButton36_Click()
    Application.EnableEvents = False
    'Other code
    Application.EnableEvents = True
End Sub


Return to “Excel”

Who is online

Users browsing this forum: No registered users and 26 guests