Hỏi code VBA làm chữ ẩn hiện trên Label trong Form.

[thangteo]

Nhờ các thầy và các anh xem chỉ giúp em đoạn code khi nhấn nút NHẤP NHÁY thì chữ (hiện tại trong form nó là số 6) nó ẩn rồi hiện tức là nhấp nháy với ạ, và 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 được ạ.
Thank!

 

[Hoang2013]

Mình có câu hỏi: Làm sao thoát hay đóng Form lại vậy bạn?

 

[thangteo]

Mình có câu hỏi: Làm sao thoát hay đóng Form lại vậy bạn?

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.

 

[phuyen89]

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é!

- Mình có biết Window API có hàm Flash cho Form nó nhấp nháy, còn Label nhấp nháy thì chưa.

 

[thangteo]

- Mình có biết Window API có hàm Flash cho Form nó nhấp nháy, còn Label nhấp nháy thì chưa.

Vâng, nhờ các cao thủ.

 

[ndu96081631]

Nhờ các thầy và các anh xem chỉ giúp em đoạn code khi nhấn nút NHẤP NHÁY thì chữ (hiện tại trong form nó là số 6) nó ẩn rồi hiện tức là nhấp nháy với ạ, và 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 được ạ.
Thank!

Chèn code dưới đây vào 1 module:

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:

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

Màu mè gì thêm nữa.. bạn tự mình tùy biến nhé

 

[thangteo]

Chèn code dưới đây vào 1 module:

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:

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

Màu mè gì thêm nữa.. bạn tự mình tùy biến nhé

Em đã làm theo như hướng dẫn mà chạy im re, liệu có sai gì ở chỗ "NH" & ChrW(7844) & "P NHÁY" không ạ. Liệu chữ NHÁY có ổn trong code VBA không ạ?

 

[thangteo]

Em đã làm theo như hướng dẫn mà chạy im re, liệu có sai gì ở chỗ "NH" & ChrW(7844) & "P NHÁY" không ạ. Liệu chữ NHÁY có ổn trong code VBA không ạ?

Dạ được rồi thầy ạ. Do lỗi chữ trên comandbutton với code thôi ạ. Nhưng thầy ơi, khoảng thời gian tùy chỉnh cho nhấp nháy nhanh chậm thế nào được ạ.?

 

[phuyen89]

Dạ được rồi thầy ạ. Do lỗi chữ trên comandbutton với code thôi ạ. Nhưng thầy ơi, khoảng thời gian tùy chỉnh cho nhấp nháy nhanh chậm thế nào được ạ.?

- Bạn thử chỉnh chỗ valT= now()+timeseria xem sao

 

[be_09]

........ 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

Tôi thấy bạn nên làm một ứng dụng cho tốt để sử dụng còn hơn làm ba cái hoa lá cành (chỉ xem chơi cho vui) chẳng có tác dụng gì cả.

 

[ndu96081631]

Dạ được rồi thầy ạ. Do lỗi chữ trên comandbutton với code thôi ạ. Nhưng thầy ơi, khoảng thời gian tùy chỉnh cho nhấp nháy nhanh chậm thế nào được ạ.?

Thì chỗ:

If (Second(Now) Mod 2) Then

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:

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

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

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é!

 

[Kiều Mạnh]

Thì chỗ:

If (Second(Now) Mod 2) Then

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:

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

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

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é!

Không biết anh làm gì mà Em thử tí mà không có đường tắt được ...Phải Task manager nó mới chịu

 

[ndu96081631]

Không biết anh làm gì mà Em thử tí mà không có đường tắt được ...Phải Task manager nó mới chịuView attachment 178378

Làm gì đâu! Form ấy là "zin" của người ta nó vậy: Ẩn nút Close nên muốn tắt chỉ có cách Alt + F4
(làm gì mà đến mức Task Manager?(

 

[thangteo]

Tôi thấy bạn nên làm một ứng dụng cho tốt để sử dụng còn hơn làm ba cái hoa lá cành (chỉ xem chơi cho vui) chẳng có tác dụng gì cả.

Dạ vâng cảm ơn góp ý của anh ạ. E sẽ cố gắng.

 

[thangteo]

Không biết anh làm gì mà Em thử tí mà không có đường tắt được ...Phải Task manager nó mới chịuView attachment 178378

Bạn lấy file ở #8 là ok nhé! Mình đã cho nó hiện, không ẩn nữa.

 

[thangteo]

Thì chỗ:

If (Second(Now) Mod 2) Then

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:

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

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

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é!

Thầy ơi! File bật lên báo lỗi này ạ, cả 2 file lỗi như nhau:

 

[ndu96081631]

Thầy ơi! File bật lên báo lỗi này ạ, cả 2 file lỗi như nhau:

Vậy thì cứ chỗ nào có PtrSafe thì xóa đi. Chỗ nào LongPtr thì sửa thành Long
Vậy đi! Khỏi suy nghĩ

 

[thangteo]

Vậy thì cứ chỗ nào có PtrSafe thì xóa đi. Chỗ nào LongPtr thì sửa thành Long
Vậy đi! Khỏi suy nghĩ

Đã ổn thầy à, xin thầy cho chút kiến thức về chỗ PtrSafe và LongPrt ạ? Lười tìm hiểu mong thầy bỏ quá!

 

[ndu96081631]

Đã ổn thầy à, xin thầy cho chút kiến thức về chỗ PtrSafe và LongPrt ạ? Lười tìm hiểu mong thầy bỏ quá!

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?

 

[thangteo]

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ó)

Dạ vâng ạ! Thực sự ngả mũ và nể phục kiến thức của thầy.