Xin trợ giúp CODE để chuyển màn hình từ Excel sang trang Web

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

HuuThang231

Thành viên mới
Tham gia
6/8/17
Bài viết
7
Được thích
0
Giới tính
Nam
Xin chào mọi người trong diễn đàn!
Mình đang phát triển một macro để hỗ trợ trong công việc của mình. Tuy nhiên, mình đang gặp khó khăn khi cố gắng tạo mã để chuyển đổi từ màn hình Excel sang trang web mà mình đang sử dụng. Mình sử dụng phiên bản Excel 2010 và đang mở cùng lúc Excel và trang web đó. Mong được các bạn hỗ trợ về mã code để thực hiện công việc này. Cảm ơn mọi người rất nhiều.
 
Nếu điều khiển trang Web, lấy dữ liệu của trang Web về, hay nhập dữ liệu cho trang Web thì hơi khó.
Còn trường hợp chỉ bật trang WEB lên thôi thì không khó.
Mã: 
Sub chup_man_hinh_trangweb()
    Dim bot As New Selenium.ChromeDriver
    bot.Start "Chrome", "https://vnexpress.net"
    bot.Get "/"
    bot.TakeScreenshot.SaveAs (ThisWorkbook.Path + "/screenshot.jpg")
    bot.Quit
End Sub
Ở trên là Ví dụ bật màn hình trang Web vnexpress lên, rồi chụp lại màn hình Web, rồi tắt trang web.
Nhưng để chạy được code này bạn cần cài Download ChromeDriver bản phù hợp, rồi Download cài đặt Selenium thì mới sử dụng code được.
Từ khóa google: chromedriver selenium
 
Tình nghĩa giang hồ đã viết:
Nếu điều khiển trang Web, lấy dữ liệu của trang Web về, hay nhập dữ liệu cho trang Web thì hơi khó.
Còn trường hợp chỉ bật trang WEB lên thôi thì không khó.
Mã: 
Sub chup_man_hinh_trangweb()
    Dim bot As New Selenium.ChromeDriver
    bot.Start "Chrome", "https://vnexpress.net"
    bot.Get "/"
    bot.TakeScreenshot.SaveAs (ThisWorkbook.Path + "/screenshot.jpg")
    bot.Quit
End Sub
Ở trên là Ví dụ bật màn hình trang Web vnexpress lên, rồi chụp lại màn hình Web, rồi tắt trang web.
Nhưng để chạy được code này bạn cần cài Download ChromeDriver bản phù hợp, rồi Download cài đặt Selenium thì mới sử dụng code được.
Từ khóa google: chromedriver selenium
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn,như mình hiểu là cách của bạn sẽ tạo ra 1 tab là vnexpress.net rồi abcxyz.Tuy nhiên cái của mình cần lại đơn giản hơn,mình đã bật sẵn trang Web của mình,chỉ là mình muốn đang từ màn hình Excel,ấn 1 nút Shapes thì macro tự đổi màn hình sang trang Web kia,tks bạn nhiều
 
HuuThang231 đã viết:
Cảm ơn bạn,như mình hiểu là cách của bạn sẽ tạo ra 1 tab là vnexpress.net rồi abcxyz.Tuy nhiên cái của mình cần lại đơn giản hơn,mình đã bật sẵn trang Web của mình,chỉ là mình muốn đang từ màn hình Excel,ấn 1 nút Shapes thì macro tự đổi màn hình sang trang Web kia,tks bạn nhiều
Nhấp chuột vào đây để mở rộng...
Giống như bấm tổ hợp Alt+Tab phải không nhỉ?
 
@HuuThang231
Dùng WinAPI điều khiển Handle của Chrome đó bạn, chỉ cần biết tiêu đề Chrome đang mở.


1677254347175.png

Thử:
JavaScript: 
Private Sub ChromeShowByTitle_test()
  Debug.Print ChromeShowByTitle("Xin tr*", "Zalo*", "Facebook*")
  Debug.Print ChromeShowByTitle("Twitter*")
End Sub

(Sao chép mã vào module mới)
JavaScript: 
Option Explicit
Option Compare Text
Option Private Module

 Type v64
#If VBA7 And Win64 Then
'z As LongLong
'#ElseIf VBA7 Then
z As LongPtr
#Else
z As Long
#End If
End Type
#If VBA7 Then
  #If Win64 Then
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function GetWindowLongPtrW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr
  #Else
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetWindowLongPtrW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  #End If
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetAncestor Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal gaFlags As Long) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetClassNameW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function IsWindowUnicode Lib "user32" (ByVal hwnd As LongPtr) As Boolean
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Boolean
#Else
Private Declare Function GetWindowTextW Lib "user32" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
Private Declare Function GetAncestor Lib "user32.dll" (ByVal hwnd As Long, ByVal gaFlags As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" ()
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1$, ByVal lpsz2$) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName$, ByVal nMaxCount As Long) As Long
Private Declare Function GetClassNameW Lib "user32" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString$, ByVal cch As Long) As Long
#End If

#If VBA7 Then
 Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
 Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
 Private Declare PtrSafe Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
 Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
 Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
#Else
 Private Declare Function GetForegroundWindow Lib "user32" () As Long
 Private Declare Function GetWindowThreadProcessId Lib "USER32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
 Private Declare Function AttachThreadInput Lib "USER32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
 Private Declare Function SetForegroundWindow Lib "USER32" (ByVal hwnd As Long) As Long
 Private Declare Function IsIconic Lib "USER32" (ByVal hwnd As Long) As Long
#End If


Private Function ChromeShowByTitle(ParamArray Title()) As Boolean
  Const x = 256
  Dim h As v64, hparent As v64, childCount&, l&, s$, s2$, i
  h.z = GetDesktopWindow
  childCount = 0:
  h.z = GetWindow(h.z, 5)
  Do While h.z <> 0:
    childCount = childCount + 1:
    s = Space(x): s2 = Space(x)
    If IsWindowUnicode(h.z) Then
      l = GetClassNameW(h.z, s, x): s = Left(StrConv(s, vbFromUnicode), l)
      l = GetWindowTextW(h.z, s2, x): s2 = Left(StrConv(s2, vbFromUnicode), l)
    Else
      l = GetClassName(h.z, s, x): s = Left(s, l)
      l = GetWindowText(h.z, s2, x): s2 = Left(s2, l)
    End If
    If s Like "Chrome_WidgetWin_1" Then
      For Each i In Title
        If s2 Like i Then BringWindowToFront h: ChromeShowByTitle = True: Exit Function
      Next
    End If
    h.z = GetWindow(h.z, 2)
  Loop
End Function



Private Function InstanceToWnd(ByVal target_pid As Long, Optional ByVal Title$, Optional ByVal Class$) As v64
  Dim hwnd As v64, h2 As v64

  Dim pid As Long, thread_id As Long, i&
  hwnd.z = FindWindow(Class, Title)
  i = 2: h2 = hwnd
l:
  Do While h2.z <> 0
    If GetParent(h2.z) = 0 Then
      thread_id = GetWindowThreadProcessId(h2.z, pid)
      If pid = target_pid Then InstanceToWnd = h2: Exit Function
    End If
    h2.z = GetWindow(h2.z, i)
  Loop
  If i = 2 Then h2 = hwnd: i = 3: GoTo l
End Function

Private Function BringWindowToFront(hwnd As v64) As Boolean

  Dim ThreadID1 As Long, ThreadID2 As Long, nRet As Long
  On Error Resume Next
  If hwnd.z = GetForegroundWindow() Then
    BringWindowToFront = True
  Else
    ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
    ThreadID2 = GetWindowThreadProcessId(hwnd.z, ByVal 0&)
    Call AttachThreadInput(ThreadID1, ThreadID2, True)
    nRet = SetForegroundWindow(hwnd.z)
    If IsIconic(hwnd.z) Then
      Call ShowWindow(hwnd.z, 9) ' SW_RESTORE)
      Call ShowWindow(hwnd.z, 4) 'SW_SHOW)
    Else
      Call ShowWindow(hwnd.z, 1) 'SW_SHOW 5)
    End If
    BringWindowToFront = CBool(nRet)
    Call AttachThreadInput(ThreadID1, ThreadID2, False)
  End If
  Err.Clear
End Function
 
Lần chỉnh sửa cuối:
Maika8008 đã viết:
Giống như bấm tổ hợp Alt+Tab phải không nhỉ?
Nhấp chuột vào đây để mở rộng...
Đúng rồi bạn ạ.Mình cần trang Web được bật lên để chạy tiếp Macro ạ
Bài đã được tự động gộp:

ptm0412 đã viết:
Sao không phải là ấn icon của web browser trên taskbar?
Nhấp chuột vào đây để mở rộng...
dạ,mình muốn ấn vào nút Shapes để hiện lên cửa sổ trang Web để tiếp tục chạy Macro ạ
Bài đã được tự động gộp:

HeSanbi đã viết:
@HuuThang231
Dùng WinAPI điều khiển Handle của Chrome đó bạn, chỉ cần biết tiêu đề Chrome đang mở.


View attachment 286899

Thử:
JavaScript: 
Private Sub ChromeShowByTitle_test()
  Debug.Print ChromeShowByTitle("Xin tr*")
End Sub

(Sao chép mã vào module mới)
JavaScript: 
Option Explicit
Option Compare Text
Option Private Module

#If VBA7 Then
  #If Win64 Then
    Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
    Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Declare PtrSafe Function GetWindowLongPtrW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr
  #Else
    Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As Long
    Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function GetWindowLongPtrW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  #End If
Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Declare PtrSafe Function GetAncestor Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal gaFlags As Long) As LongPtr
Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As Long
Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare PtrSafe Function GetClassNameW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare PtrSafe Function IsWindowUnicode Lib "user32" (ByVal hwnd As LongPtr) As Boolean
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Declare PtrSafe Function GetWindowTextW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Boolean
#Else
Declare Function GetWindowTextW Lib "user32" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetDesktopWindow Lib "USER32" () As Long
Declare Function GetAncestor Lib "user32.dll" (ByVal hwnd As Long, ByVal gaFlags As Long) As Long
Declare Function GetCurrentThreadId Lib "kernel32" ()
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1$, ByVal lpsz2$) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName$, ByVal nMaxCount As Long) As Long
Declare Function GetClassNameW Lib "user32" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Boolean
Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString$, ByVal cch As Long) As Long
#End If

#If VBA7 Then

Declare PtrSafe Function RedrawWindow Lib "user32" (ByVal hwnd As LongPtr, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Declare PtrSafe Function BeginDeferWindowPos Lib "user32" (ByVal nNumWindows As Long) As Long
Declare PtrSafe Function DeferWindowPos Lib "user32" (ByVal hWinPosInfo As Long, ByVal hwnd As LongPtr, ByVal HwndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare PtrSafe Function EndDeferWindowPos Lib "user32" (ByVal hWinPosInfo As Long) As Long
Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long

#Else
Declare Function RedrawWindow Lib "user32" Alias "RedrawWindow" (ByVal hwnd As Long, lprcUpdate As any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Declare Function BeginDeferWindowPos Lib "user32"  (ByVal nNumWindows As Long) As Long
Declare Function DeferWindowPos Lib "user32"  (ByVal hWinPosInfo As Long, ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function EndDeferWindowPos Lib "user32"  (ByVal hWinPosInfo As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
#End If

#If VBA7 Then
Public Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Public Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
Public Declare PtrSafe Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
#Else
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowThreadProcessId Lib "USER32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function AttachThreadInput Lib "USER32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Public Declare Function SetForegroundWindow Lib "USER32" (ByVal hwnd As Long) As Long
Public Declare Function IsIconic Lib "USER32" (ByVal hwnd As Long) As Long
#End If


Function ChromeShowByTitle(ByVal chromeTitle$) As Boolean
  #If VBA7 And Win64 Then
    Dim h As LongPtr
  #Else
    Dim h As Long
  #End If
  Dim l&, s$, p
  For Each p In GetObject("winmgmts:\\.\root\CIMV2") _
                  .ExecQuery("SELECT * FROM Win32_Process WHERE (Name = ""msedge.exe"" or Name = ""chrome.exe"")", , 48)
    h = InstanceToWnd(p.processid, Class:="Chrome_WidgetWin_1")
    If h > 0 Then
      s = Space(256)
      If IsWindowUnicode(h) Then
        l = GetWindowTextW(h, s, 256): s = Left(StrConv(s, vbFromUnicode), l)
      Else
        l = GetWindowText(h, s, 256): s = Left(s, l)
      End If
      If s Like chromeTitle Then apiSetWindowZOrder h, 0: ChromeShowByTitle = True: Exit For
    End If
  Next
End Function

#If VBA7 And Win64 Then
Public Sub apiSetWindowZOrder(hwnd As LongPtr, HwndInsertAfter As LongPtr)
Dim v As LongPtr, h As LongPtr, l As Long
#Else
Public Sub apiSetWindowZOrder(hwnd As Long, HwndInsertAfter As Long)
Dim v As Long, h As Long, l As Long
#End If
  h = GetAncestor(hwnd, 1)
  Call apiGetWindowChilds(h, l)
  l = BeginDeferWindowPos(l)
  l = DeferWindowPos(l, hwnd, HwndInsertAfter, 0, 0, 0, 0, &H2 Or &H1)
  Call EndDeferWindowPos(l)
End Sub

#If VBA7 And Win64 Then
Function InstanceToWnd(ByVal target_pid As Long, Optional ByVal Title$, Optional ByVal Class$) As LongPtr
#Else
Function InstanceToWnd(ByVal target_pid As Long, Optional ByVal Title$, Optional ByVal Class$) As Long
#End If
  #If VBA7 And Win64 Then
    Dim hwnd As LongPtr
  #Else
    Dim hwnd As Long
  #End If
  Dim pid As Long, thread_id As Long
  hwnd = FindWindow(Class, Title)
  Do While hwnd <> 0
    If GetParent(hwnd) = 0 Then
      thread_id = GetWindowThreadProcessId(hwnd, pid)
      If pid = target_pid Then InstanceToWnd = hwnd: Exit Do
    End If
    hwnd = GetWindow(hwnd, 2)
  Loop
End Function

#If VBA7 And Win64 Then
Private Function apiGetWindowChilds(hParent As LongPtr, Optional childCount&)
    Dim h As LongPtr
#Else
Private Function apiGetWindowChilds(hParent As Long, Optional childCount&)
    Dim h As Long
#End If
  childCount = 0: h = GetWindow(hParent, 5)
  While h <> 0: childCount = childCount + 1: h = GetWindow(h, 2): Wend
End Function
Nhấp chuột vào đây để mở rộng...
tks bạn,mình sẽ thử
 
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

HeSanbi
  • Question Question
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
0
Đọc
34
HeSanbi
HeSanbi
tuv8x
Xin hỏi cách giới hạn vùng làm việc
Trả lời
2
Đọc
42
tuv8x
tuv8x
gamo_excel
Hàm Index trả về nhiều kết quả
Trả lời
12
Đọc
1K
VetMini
V
N
tắt bảo vệ trang tính
Trả lời
2
Đọc
40
ngọcanh@123
N
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
33
Đọc
12K
tnson1
tnson1
X
Đường lưới trong file excel bị mất
Trả lời
11
Đọc
8K
GREEN HOTEL CO
GREEN HOTEL CO
C
Tìm dữ liệu khác nhau trong 2 file hoặc 2 sheet trong excel
Trả lời
1
Đọc
70
vanle33
vanle33
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
2
Trả lời
23
Đọc
1K
CHAOQUAY
C
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
1
Đọc
103
HeSanbi
HeSanbi
T
Game xóc đĩa trên excel
    • Cười
Trả lời
11
Đọc
2K
SA_DQ
SA_DQ
Ljxxerti
Mình hỏi về hàm excel
Trả lời
1
Đọc
64
bebo021999
B
Lyvanduong
  • Question Question
Mn cho em hỏi với lỗi 1004 ở Excel này thì xử lí như nào ạ
Trả lời
2
Đọc
91
HeSanbi
HeSanbi
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
1
Đọc
83
yaaasoo01
Y
D
Paste dữ liệu, bỏ qua các cell ẩn
2
Trả lời
28
Đọc
45K
HeSanbi
HeSanbi
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
9
Đọc
197
vuonghienst92
V
D
In sheet trong excel chi ra giấy trắng
Trả lời
7
Đọc
12K
binhht79
B
H
  • Question Question
[Help]làm cách nào để đếm không trùng thỏa 1 điều kiện
Trả lời
1
Đọc
74
hoangtuaotrang_hp_vn
H
minhminh040499
Filter không hoạt động.
    • Cười
Trả lời
7
Đọc
159
minhminh040499
minhminh040499
D
  • Question Question
Lỗi run-time error '1004'
2
Trả lời
21
Đọc
46K
Lyvanduong
Lyvanduong
K
Cảnh báo add-in có virus
    • Thích
    • Cười
Trả lời
13
Đọc
593
hoangtuan.net
hoangtuan.net
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom