Chắc do em không để ý chọn ở thuộc tính form, cứ tạm thời thoát form chọn ALT+F4 các anh nhé, còn nếu nhờ các anh làm được thì gán nó nhấp nháy mấy lần rồi tự exit form luôn.
Private valT As Double
Sub T_Start()
valT = Now + TimeSerial(0, 0, 1)
With UserForm1.Label1
If (Second(Now) Mod 2) Then
.ForeColor = .BackColor
Else
.ForeColor = &HFF00&
End If
Application.OnTime valT, "T_Start", , True
UserForm1.Repaint
End With
End Sub
Sub T_Stop()
On Error Resume Next
Application.OnTime valT, "T_Start", , False
End Sub
Code cho CommandButton1 trên UserForm:
Mã:
Private Sub CommandButton1_Click()
Dim bChk As Boolean
Dim sStart As String, sStop As String
sStart = "NH" & ChrW(7844) & "P NHÁY"
sStop = "NG" & ChrW(7914) & "NG"
bChk = (CommandButton1.Caption = sStart)
If bChk Then T_Start Else: T_Stop
CommandButton1.Caption = IIf(bChk, sStop, sStart)
End Sub
Private valT As Double
Sub T_Start()
valT = Now + TimeSerial(0, 0, 1)
With UserForm1.Label1
If (Second(Now) Mod 2) Then
.ForeColor = .BackColor
Else
.ForeColor = &HFF00&
End If
Application.OnTime valT, "T_Start", , True
UserForm1.Repaint
End With
End Sub
Sub T_Stop()
On Error Resume Next
Application.OnTime valT, "T_Start", , False
End Sub
Code cho CommandButton1 trên UserForm:
Mã:
Private Sub CommandButton1_Click()
Dim bChk As Boolean
Dim sStart As String, sStop As String
sStart = "NH" & ChrW(7844) & "P NHÁY"
sStop = "NG" & ChrW(7914) & "NG"
bChk = (CommandButton1.Caption = sStart)
If bChk Then T_Start Else: T_Stop
CommandButton1.Caption = IIf(bChk, sStop, sStart)
End Sub
........ chỉ giúp em đoạn code khi nhấn nút NHẤP NHÁY thì chữ ................. có thể thay đổi tốc độc nhấp nháy theo khoảng thời gian mà mình có thể thay đổi trong code
là thời gian chớp tắt đó. Code thế nghĩa là 1 giây sáng, 1 giây tắt. Muốn tăng 1 giây lên 2 giây thì.. làm sao? Bạn tự suy nghĩ đi chứ
Gợi ý: Ở trên dùng Mod, giờ kết hợp thêm INT nữa là được
---------------------------
Tuy nhiên: code trên thuộc dạng đơn giản, chạy sẽ không "mượt". Trong khi đó tôi biết có thể bạn định dùng code này cho dự án lớn nào đó. Vậy giải pháp tổng thể cho bạn luôn
1> Code trong module1:
Mã:
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Public lCount As Long
Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
lCount = lCount + 1
With UserForm1.Label1
If (lCount Mod 2) Then
.ForeColor = .BackColor
Else
.ForeColor = &HFF00&
End If
UserForm1.Repaint
End With
End Function
Sub StartTimer()
On Error Resume Next
StopTimer
SetTimer Application.hWnd, 1, 500, AddressOf TimeProc
End Sub
Sub StopTimer()
On Error Resume Next
KillTimer Application.hWnd, 1
End Sub
2> Code trong UserForm1
Mã:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU As Long = &H80000
Dim hWnd As LongPtr, uStyle As Long, lCount As Long
Private Sub CommandButton1_Click()
Dim bChk As Boolean
Dim sStart As String, sStop As String
sStart = "NH" & ChrW(7844) & "P NHÁY"
sStop = "NG" & ChrW(7914) & "NG"
lCount = 0
bChk = (CommandButton1.Caption = sStart)
If bChk Then StartTimer Else: StopTimer
CommandButton1.Caption = IIf(bChk, sStop, sStart)
End Sub
Private Sub UserForm_Initialize()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
uStyle = GetWindowLong(hWnd, GWL_STYLE)
SetWindowLong hWnd, GWL_STYLE, uStyle And Not WS_SYSMENU
End Sub
Private Sub UserForm_Terminate()
StopTimer
End Sub
Ở đây bạn chỉ cần chú ý Sub StartTimer
Mã:
Sub StartTimer()
On Error Resume Next
StopTimer
SetTimer Application.hWnd, 1, 500, AddressOf TimeProc
End Sub
Con số 500 là thời gian. Tăng số này lên nghĩa là giảm tốc độ chớp tắt và ngược lại
Làm sơ qua, bạn test lại giúp nhé!
là thời gian chớp tắt đó. Code thế nghĩa là 1 giây sáng, 1 giây tắt. Muốn tăng 1 giây lên 2 giây thì.. làm sao? Bạn tự suy nghĩ đi chứ
Gợi ý: Ở trên dùng Mod, giờ kết hợp thêm INT nữa là được
---------------------------
Tuy nhiên: code trên thuộc dạng đơn giản, chạy sẽ không "mượt". Trong khi đó tôi biết có thể bạn định dùng code này cho dự án lớn nào đó. Vậy giải pháp tổng thể cho bạn luôn
1> Code trong module1:
Mã:
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Public lCount As Long
Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
lCount = lCount + 1
With UserForm1.Label1
If (lCount Mod 2) Then
.ForeColor = .BackColor
Else
.ForeColor = &HFF00&
End If
UserForm1.Repaint
End With
End Function
Sub StartTimer()
On Error Resume Next
StopTimer
SetTimer Application.hWnd, 1, 500, AddressOf TimeProc
End Sub
Sub StopTimer()
On Error Resume Next
KillTimer Application.hWnd, 1
End Sub
2> Code trong UserForm1
Mã:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU As Long = &H80000
Dim hWnd As LongPtr, uStyle As Long, lCount As Long
Private Sub CommandButton1_Click()
Dim bChk As Boolean
Dim sStart As String, sStop As String
sStart = "NH" & ChrW(7844) & "P NHÁY"
sStop = "NG" & ChrW(7914) & "NG"
lCount = 0
bChk = (CommandButton1.Caption = sStart)
If bChk Then StartTimer Else: StopTimer
CommandButton1.Caption = IIf(bChk, sStop, sStart)
End Sub
Private Sub UserForm_Initialize()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
uStyle = GetWindowLong(hWnd, GWL_STYLE)
SetWindowLong hWnd, GWL_STYLE, uStyle And Not WS_SYSMENU
End Sub
Private Sub UserForm_Terminate()
StopTimer
End Sub
Ở đây bạn chỉ cần chú ý Sub StartTimer
Mã:
Sub StartTimer()
On Error Resume Next
StopTimer
SetTimer Application.hWnd, 1, 500, AddressOf TimeProc
End Sub
Con số 500 là thời gian. Tăng số này lên nghĩa là giảm tốc độ chớp tắt và ngược lại
Làm sơ qua, bạn test lại giúp nhé!
là thời gian chớp tắt đó. Code thế nghĩa là 1 giây sáng, 1 giây tắt. Muốn tăng 1 giây lên 2 giây thì.. làm sao? Bạn tự suy nghĩ đi chứ
Gợi ý: Ở trên dùng Mod, giờ kết hợp thêm INT nữa là được
---------------------------
Tuy nhiên: code trên thuộc dạng đơn giản, chạy sẽ không "mượt". Trong khi đó tôi biết có thể bạn định dùng code này cho dự án lớn nào đó. Vậy giải pháp tổng thể cho bạn luôn
1> Code trong module1:
Mã:
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Public lCount As Long
Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
lCount = lCount + 1
With UserForm1.Label1
If (lCount Mod 2) Then
.ForeColor = .BackColor
Else
.ForeColor = &HFF00&
End If
UserForm1.Repaint
End With
End Function
Sub StartTimer()
On Error Resume Next
StopTimer
SetTimer Application.hWnd, 1, 500, AddressOf TimeProc
End Sub
Sub StopTimer()
On Error Resume Next
KillTimer Application.hWnd, 1
End Sub
2> Code trong UserForm1
Mã:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU As Long = &H80000
Dim hWnd As LongPtr, uStyle As Long, lCount As Long
Private Sub CommandButton1_Click()
Dim bChk As Boolean
Dim sStart As String, sStop As String
sStart = "NH" & ChrW(7844) & "P NHÁY"
sStop = "NG" & ChrW(7914) & "NG"
lCount = 0
bChk = (CommandButton1.Caption = sStart)
If bChk Then StartTimer Else: StopTimer
CommandButton1.Caption = IIf(bChk, sStop, sStart)
End Sub
Private Sub UserForm_Initialize()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
uStyle = GetWindowLong(hWnd, GWL_STYLE)
SetWindowLong hWnd, GWL_STYLE, uStyle And Not WS_SYSMENU
End Sub
Private Sub UserForm_Terminate()
StopTimer
End Sub
Ở đây bạn chỉ cần chú ý Sub StartTimer
Mã:
Sub StartTimer()
On Error Resume Next
StopTimer
SetTimer Application.hWnd, 1, 500, AddressOf TimeProc
End Sub
Con số 500 là thời gian. Tăng số này lên nghĩa là giảm tốc độ chớp tắt và ngược lại
Làm sơ qua, bạn test lại giúp nhé!
Mấy vụ đó liên quan đến 32bit và 64bit ấy
Mò mò trên google từ khóa liên quan đến PtrSafe sẽ có cả đống (diễn đàn mình cũng có)
Ah, nhân tiện mình hỏi thêm:
- Bạn dùng Windows 32 hay 64?
- Bạn dùng Office 32 hay 64?