Nhắn Zl bằng Excel

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
anhkiet7890

anhkiet7890

Thành viên mới
Tham gia
5/1/23
Bài viết
9
Được thích
0
Em lang thang trên YouTube tìm đc bài này hay
Tóm tắt nội dung:
Excel: copy tên người nhận sau đó vào ô tìm kiếm zl dán và click vào ô kết quả, sau đó vào excel copy nội dung dán vào gửi, sau khi gửi xong người này thì tiếp tục gửi người thứ 2 cứ như vậy
B1: đưa chuột vào ô tìm kiếm zl rồi kich vào ô lấy tọa độ điền vào ô vị trí nhập, sau đó copy vào ô tìm kiếm,
Sau đó click chuột vào ô kết quả
Tiếp theo đó lấy tọa độ thứ 2 điền vào ô nhắn tin và nhấn phím gửi
Em có thêm ô nhập thời gian nữa. Có ai giải đc bài này không ạ
IMG_20240103_144813.png
 

File đính kèm

  • HOI ZL.xlsx
    10.5 KB · Đọc: 13
Hình như nó có addin này sao ấy mà
 
Có anh chị nào sửa code em với ạ

module 1
#If VBA7 And Win64 Then
'64bit
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Declare PtrSafe Function setcursorpos Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long
#Else
'32 bit
Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Declare Function setcursorpos Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long
#End If

Type PointAPI
X_Pos As Long
Y_Pos As Long
End Type

Sub DATTOADO()
Dim Hold As PointAPI
Sheet1.Range("B3:C4").Clear

Application.Wait Now + TimeSerial(0, 0, 5)
GetCursorPos Hold
Sheet1.Range("B3").Value = Hold.X_Pos
Sheet1.Range("C3").Value = Hold.Y_Pos

Application.Wait Now + TimeSerial(0, 0, 5)
GetCursorPos Hold
Sheet1.Range("B4").Value = Hold.X_Pos
Sheet1.Range("C4").Value = Hold.Y_Pos
End Sub


--------------

Code Module 2
#If VBA7 And Win64 Then
'64bit
Public Declare PtrSafe Function setCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As LongPtr
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
#Else
'32 bit
Public Declare Function setcursorpos Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
#End If

Public Const mouseeventf_leftdown As Long = &H2
Public Const mouseeventf_leftup As Long = &H4
Public Const mouseeventF_Rightdown As Long = &H8
Public Const mouseeventF_rightup As Long = &H10

'Declare sleep
Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Sub Chaytudong()
Dim i As Long, j As Long
j = Sheet1.Range("E" & Rows.Count).End(xlUp).Row 'tim dong cuoi so dt

For i = 2 To j
If Sheet1.Range("A1") <> "" Then
Exit Sub
End If

If Sheet1.Range("A" & i) <> "" Then
Sheet1.Range("E" & i).Copy
Sheet1.Range("F" & i).Value = "ok"

Application.Wait Now + TimeSerial(0, 0, 1)
setCursorPos Sheet1.Range("B3").Value, Sheet1.Range("C3").Value 'x and y position

Application.Wait Now + TimeSerial(0, 0, 1)
mouse_event mouseeventf_leftdown, 0, 0, 0, 0
mouse_event mouseeventf_leftup, 0, 0, 0, 0
mouse_event mouseeventf_leftdown, 0, 0, 0, 0
mouse_event mouseeventf_leftup, 0, 0, 0, 0

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("~")

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("^v")

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("~")

Sheet1.Range("G1:G20").Copy

Application.Wait Now + TimeSerial(0, 0, 1)
setCursorPos Sheet1.Range("B4").Value, Sheet1.Range("C4").Value 'x and y position

Application.Wait Now + TimeSerial(0, 0, 1)
mouse_event mouseeventf_leftdown, 0, 0, 0, 0
mouse_event mouseeventf_leftup, 0, 0, 0, 0

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("^v")

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("~")

Application.SendKeys ("~")
End If
Next
End Sub
 
Dùng SendKeys thì hổng cỡ khoảng 50% nếu may mắn. Không kiểm soát được kết quả của hành động thực hiện lệnh.
 
anhkiet7890 đã viết:
Có anh chị nào sửa code em với ạ

module 1
#If VBA7 And Win64 Then
'64bit
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Declare PtrSafe Function setcursorpos Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long
#Else
'32 bit
Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Declare Function setcursorpos Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long
#End If

Type PointAPI
X_Pos As Long
Y_Pos As Long
End Type

Sub DATTOADO()
Dim Hold As PointAPI
Sheet1.Range("B3:C4").Clear

Application.Wait Now + TimeSerial(0, 0, 5)
GetCursorPos Hold
Sheet1.Range("B3").Value = Hold.X_Pos
Sheet1.Range("C3").Value = Hold.Y_Pos

Application.Wait Now + TimeSerial(0, 0, 5)
GetCursorPos Hold
Sheet1.Range("B4").Value = Hold.X_Pos
Sheet1.Range("C4").Value = Hold.Y_Pos
End Sub


--------------

Code Module 2
#If VBA7 And Win64 Then
'64bit
Public Declare PtrSafe Function setCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As LongPtr
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
#Else
'32 bit
Public Declare Function setcursorpos Lib "user32" Alias "SetCursorPos" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
#End If

Public Const mouseeventf_leftdown As Long = &H2
Public Const mouseeventf_leftup As Long = &H4
Public Const mouseeventF_Rightdown As Long = &H8
Public Const mouseeventF_rightup As Long = &H10

'Declare sleep
Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Sub Chaytudong()
Dim i As Long, j As Long
j = Sheet1.Range("E" & Rows.Count).End(xlUp).Row 'tim dong cuoi so dt

For i = 2 To j
If Sheet1.Range("A1") <> "" Then
Exit Sub
End If

If Sheet1.Range("A" & i) <> "" Then
Sheet1.Range("E" & i).Copy
Sheet1.Range("F" & i).Value = "ok"

Application.Wait Now + TimeSerial(0, 0, 1)
setCursorPos Sheet1.Range("B3").Value, Sheet1.Range("C3").Value 'x and y position

Application.Wait Now + TimeSerial(0, 0, 1)
mouse_event mouseeventf_leftdown, 0, 0, 0, 0
mouse_event mouseeventf_leftup, 0, 0, 0, 0
mouse_event mouseeventf_leftdown, 0, 0, 0, 0
mouse_event mouseeventf_leftup, 0, 0, 0, 0

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("~")

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("^v")

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("~")

Sheet1.Range("G1:G20").Copy

Application.Wait Now + TimeSerial(0, 0, 1)
setCursorPos Sheet1.Range("B4").Value, Sheet1.Range("C4").Value 'x and y position

Application.Wait Now + TimeSerial(0, 0, 1)
mouse_event mouseeventf_leftdown, 0, 0, 0, 0
mouse_event mouseeventf_leftup, 0, 0, 0, 0

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("^v")

Application.Wait Now + TimeSerial(0, 0, 1)
Application.SendKeys ("~")

Application.SendKeys ("~")
End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn muốn sửa như thế nào nhỉ
 
Có code rồi tạo module rồi paste vào chạy thôi bạn!
 
Anh chị bào sửa lại cái code 2 e vs ạ. Không chạy đươjc
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
28
Đọc
453
shnhatha221108
S
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
3
Đọc
75
hoangtuaotrang_hp_vn
H
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3
Trả lời
54
Đọc
734
ptm0412
ptm0412
K
Tính tổng có điều kiện
Trả lời
3
Đọc
74
HieuCD
H
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
11
Đọc
8K
Tình nghĩa giang hồ
Tình nghĩa giang hồ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom