@האדם-החושב
לאחר שנים שעזבתי את זה, בקשתי בסוף שבוע שעבר מג'מיני שיכתוב לי משהו, והוא הצליח בצורה אחרת!
והנה דבריו:
זוהי תקלה קלאסית של SendKeys. מה שקורה זה שווינדוס שולח את האות "V" לפני שהספיק "להחזיק" את מקש ה-Ctrl בזיכרון של תוכנת היעד, ולכן במקום הדבקה מתקבלת האות עצמה.
כדי לפתור זאת בצורה מקצועית ויציבה, נשתמש בשיטה שנקראת Windows API. במקום "לבקש" מהמערכת ללחוץ על מקשים, אנחנו נדמה לחיצה פיזית על המקלדת. זה הרבה יותר אמין.
' הצהרות עבור המקלדת והשהיה
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Public Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
' קבועים עבור המקשים
Const VK_CONTROL As Byte = &H11
Const VK_V As Byte = &H56
Const KEYEVENTF_KEYUP As Long = &H2
Sub תוכנת_חיפוש_מתוקן()
On Error Resume Next
' 1. העתקה בטוחה מוורד
Selection.Copy
DoEvents
Sleep 200 ' זמן קצר לוודא שהטקסט בלוח
Dim AppPid As Long
AppPid = GetFirstPid("Responsa")
' 2. מעבר לתוכנה
If AppPid = 0 Then
AppPid = Shell("C:\Program Files (x86)\ResponsaCD29\RESPONSA.exe", vbNormalFocus)
Sleep 2500 ' המתנה ארוכה יותר להפעלה ראשונית
Else
AppActivate AppPid
Sleep 600 ' זמן למערכת להעביר פוקוס לחלון
End If
On Error GoTo 0
' 3. שליחת F4 לפתיחת חלון החיפוש
SendKeys "{F4}", True
Sleep 500 ' המתנה קריטית לפתיחת תיבת הטקסט בתוכנה
' 4. הדבקה באמצעות דימוי לחיצת מקשים פיזית (Control + V)
keybd_event VK_CONTROL, 0, 0, 0 ' לחיצה על Ctrl
keybd_event VK_V, 0, 0, 0 ' לחיצה על V
Sleep 100
keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 ' שחרור V
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0 ' שחרור Ctrl
Sleep 300
' 5. אישור (Enter)
SendKeys "{ENTER}", True
End Sub
Private Function GetFirstPid(applicationName As String) As Long
Dim services As Object, processes As Object, process As Object
Dim resultPid As Long
Set services = GetObject("winmgmts:\\.\root\CIMV2")
Set processes = services.ExecQuery("SELECT ProcessID FROM Win32_Process WHERE Name LIKE '%" & applicationName & "%'", , 48)
For Each process In processes
resultPid = process.ProcessID
Exit For
Next
Set processes = Nothing
Set services = Nothing
GetFirstPid = resultPid
End Function
מה תיקנו כאן?
שימוש ב-keybd_event: במקום לשלוח פקודת ^v שמתפרשת לעיתים כסתם v, אנחנו אומרים למחשב: "תלחץ על קונטרול, עכשיו תלחץ על V, עכשיו תשחרר". זה מונע את כתיבת האות V.
הגדלת ה-Sleep אחרי ה-F4: בתוכנה שציינת, לעיתים לוקח לחלון החיפוש חצי שנייה להיפתח. אם ננסה להדביק מיד, הטקסט "ייזרק" לאוויר ולא ייכנס לתיבת הטקסט.
סדר פעולות: הוספנו DoEvents ו-Sleep קטן אחרי ההעתקה כדי לוודא שוורד לא "משחרר" את הפעולה לפני שהטקסט באמת מוכן בזיכרון.
