{"id":3303,"date":"2022-03-24T00:32:59","date_gmt":"2022-03-23T16:32:59","guid":{"rendered":"https:\/\/www.bytetape.com\/?p=3303"},"modified":"2023-09-01T22:59:31","modified_gmt":"2023-09-01T14:59:31","slug":"vba%e7%88%ac%e8%99%ab%e8%a7%a3%e5%86%b3%e6%a8%a1%e6%80%81%e7%aa%97%e5%8f%a3%e7%a8%8b%e5%ba%8f%e6%8c%82%e8%b5%b7%e9%97%ae%e9%a2%98","status":"publish","type":"post","link":"https:\/\/www.bytetape.com\/?p=3303","title":{"rendered":"VBA-\u89e3\u51b3\u6a21\u6001\u7a97\u53e3\u7a0b\u5e8f\u6302\u8d77\u95ee\u9898"},"content":{"rendered":"\n<p>\u89e3\u51b3\u7f51\u9875\u6a21\u6001\u7a97\u53e3\u5bfc\u81f4VBA\u7a0b\u5e8f\u7b49\u5f85\u7684\u95ee\u9898\u3002\u4e3b\u8981\u601d\u8def\u5c31\u662f\u5728\u5f39\u7a97\u524d\u7528VBA\u521b\u5efa\u4e00\u4e2aVBS\uff0c\u901a\u8fc7VBS\u8c03\u7528\u6b64excel\u4e2d\u7684\u5b8f\u6216\u8005\u76f4\u63a5\u7531VBS\u5904\u7406\u5f39\u7a97\u3002\u5b9e\u8df5\u4e2d\u53d1\u73b0office\u4f1a\u628a\u8fd9\u79cd\u64cd\u4f5c\u68c0\u6d4b\u4e3a\u75c5\u6bd2?&#8230;..\u4f46\u662fWPS\u662f\u53ef\u4ee5\u6b63\u5e38\u4f7f\u7528\u3002\u793a\u4f8b\u4ee3\u7801\u89c1\u4e0b\uff1a<\/p>\n\n\n\n<pre class=\"EnlighterJSRAW\" data-enlighter-language=\"visualbasic\" data-enlighter-theme=\"\" data-enlighter-highlight=\"\" data-enlighter-linenumbers=\"\" data-enlighter-lineoffset=\"\" data-enlighter-title=\"\" data-enlighter-group=\"\">' \u9700\u8981\u5f15\u7528: \"Microsoft HTML Object Library\"\n\n'\u6a21\u62df\u9f20\u6807\u70b9\u51fb\uff0c\u7528\u6765\u6a21\u62df\u70b9\u51fb\u7a97\u53e3\u4f7f\u7a97\u53e3\u6fc0\u6d3b\u5e76\u83b7\u5f97\u7126\u70b9\uff08\u4e0d\u662f\u5fc5\u987b\u7684\uff09\nPublic Declare Sub mouse_event Lib \"user32\" (ByVal dwFlags As Long, _\nByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)\nPublic Declare Function GetCursorPos Lib \"user32\" (lpPoint As POINTAPI) As Long\nPublic Declare Function SetCursorPos Lib \"user32\" (ByVal x As Long, ByVal y As Long) As Long\nPublic Const MOUSEEVENTF_MOVE = &amp;amp;H1\nPublic Const MOUSEEVENTF_LEFTDOWN = &amp;amp;H2\nPublic Const MOUSEEVENTF_LEFTUP = &amp;amp;H4\nPublic Const MOUSEEVENTF_RIGHTDOWN = &amp;amp;H8\nPublic Const MOUSEEVENTF_RIGHTUP = &amp;amp;H10\nPublic Const MOUSEEVENTF_MIDDLEDOWN = &amp;amp;H20\nPublic Const MOUSEEVENTF_MIDDLEUP = &amp;amp;H40\nPublic Const MOUSEEVENTF_ABSOLUTE = &amp;amp;H8000\nType POINTAPI\n    x As Long\n    y As Long\nEnd Type\n\n'\u7528\u4e8e\u524d\u7f6e\u7a97\u53e3\uff0c\u4ee5\u4fbf\u9f20\u6807\u70b9\u51fb\uff08\u4e0d\u662f\u5fc5\u987b\u7684\uff09\nPrivate Declare Function SetWindowPos Lib \"user32\" ( _\n    ByVal hwnd As Long, _\n    ByVal hWndInsertAfter As Long, _\n    ByVal x As Long, _\n    ByVal y As Long, _\n    ByVal cx As Long, _\n    ByVal cy As Long, _\n    ByVal wFlags As Long) As Long\n\nPrivate Const SMTO_ABORTIFHUNG = &amp;amp;H2\nPrivate Const GW_CHILD = 5\nPrivate Const GW_HWNDNEXT = 2\n\nPrivate Type GUID\n   Data1 As Long\n   Data2 As Integer\n   Data3 As Integer\n   Data4(0 To 7) As Byte\nEnd Type\n\nPrivate Declare Function ShowWindow Lib \"user32\" _\n    (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long\n\nPrivate Declare Function FindWindow Lib \"user32\" Alias \"FindWindowA\" _\n    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long\n\nPrivate Declare Function GetWindowText Lib \"user32\" Alias \"GetWindowTextA\" _\n    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long\n\nPrivate Declare Function GetWindowTextLength Lib \"user32\" Alias \"GetWindowTextLengthA\" _\n    (ByVal hwnd As Long) As Long\n\nPrivate Declare Function GetWindow Lib \"user32\" _\n    (ByVal hwnd As Long, ByVal wCmd As Long) As Long\n\nPrivate Declare Function IsWindowVisible Lib \"user32\" _\n    (ByVal hwnd As Long) As Boolean\n\nPrivate Declare Function GetClassName Lib \"user32\" Alias \"GetClassNameA\" _\n    (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long\n\nPrivate Declare Function RegisterWindowMessage Lib \"user32\" _\n     Alias \"RegisterWindowMessageA\" (ByVal lpString As String) As Long\n     \nPrivate Declare Function EnumChildWindows Lib \"user32\" _\n    (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long\n\nPrivate Declare Function SendMessageTimeout Lib \"user32\" _\n    Alias \"SendMessageTimeoutA\" ( _\n    ByVal hwnd As Long, _\n    ByVal msg As Long, _\n    ByVal wParam As Long, _\n    lParam As Any, _\n    ByVal fuFlags As Long, _\n    ByVal uTimeout As Long, _\n    lpdwResult As Long) As Long\n\nPrivate Declare Function ObjectFromLresult Lib \"oleacc\" ( _\n    ByVal lResult As Long, _\n    riid As GUID, _\n    ByVal wParam As Long, _\n    ppvObject As Any) As Long\n\n'Given an IE dialog window title, find the window and return a reference\n'   to the embedded HTML document object\nFunction GetIEDialogDocument(dialogTitle As String) As IHTMLDocument\n    Dim lhWndP As Long, lhWndC As Long, doc As IHTMLDocument\n    'find the IE dialog window given its title\n    If GetHandleFromPartialCaption(lhWndP, dialogTitle) Then\n        Debug.Print \"Found dialog window - \" &amp;amp; dialogTitle &amp;amp; \"(\" &amp;amp; TheClassName(lhWndP) &amp;amp; \")\"\n        Debug.Print , \"getting the document...\"\n        Set doc = IEDOMFromhWnd(lhWndP)\n        \n        '\u8ba9\u5b50\u7a97\u53e3\u524d\u7aef\u663e\u793a,\u5982\u679c\u5b50\u7a97\u53e3\u53ef\u4ee5\u524d\u7aef\u663e\u793a\u4e0b\u9762\u7684\u5185\u5bb9\u5c31\u6ca1\u6709\u5fc5\u8981\n        Const HWND_TOPMOST = -1\n        Const HWND_NOTOPMOST = -2\n        Const SWP_NOMOVE = &amp;amp;H2\n        Const SWP_NOSIZE = &amp;amp;H1\n        Const SWP_NOZORDER = &amp;amp;H4\n        Const SWP_NOACTIVATE = &amp;amp;H10\n        Const SWP_SHOWWINDOW = &amp;amp;H40\n        Const SWP_HIDEWINDOW = &amp;amp;H80\n        Const SWP_ASYNCWINDOWPOS = &amp;amp;H4000\n        '\u8bbe\u7f6e\u7a97\u53e3\u4f4d\u7f6e\n        posX = 600\n        posY = 300\n        '\u6700\u524d\u7aef\u663e\u793a\n        SetWindowPos lhWndP, HWND_TOPMOST, posX, posY, 0, 0, SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_ASYNCWINDOWPOS\n        '\u6a21\u62df\u9f20\u6807\u70b9\u51fb\u9875\u9762\n        Dim Cp As POINTAPI\n        GetCursorPos Cp\n        SetCursorPos posX, posY\n        mouse_event &amp;amp;H2, 0, 0, 0, 0\n        mouse_event &amp;amp;H4, 0, 0, 0, 0\n        \n        '\u53d6\u6d88\u524d\u7aef\u663e\u793a\uff0c\u53d6\u6d88\u6fc0\u6d3b\n        SetWindowPos lhWndP, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE  \n    Else\n        Debug.Print \"Window '\" &amp;amp; dialogTitle &amp;amp; \"' not found!\"\n    End If\n    Set GetIEDialogDocument = doc \nEnd Function\n\n' \u51fd\u6570\uff1aIEDOMFromhWnd\u3002\n'\n' \u8fd4\u56de\uff1a\u4e00\u4e2a WebBrowser \u7a97\u53e3\u7684 IHTMLDocument \u5bf9\u8c61\u63a5\u53e3\u3002\n'\n' hWnd \u53c2\u6570\uff1aWebBrowser \u63a7\u4ef6\u7684\u53e5\u67c4\u6216 WebBrowser \u63a7\u4ef6\u6240\u5728\u7a97\u53e3\u7684\u53e5\u67c4\u3002\n'\nFunction IEDOMFromhWnd(ByVal hwnd As Long) As IHTMLDocument\n    Dim IID_IHTMLDocument As GUID\n    Dim hWndChild As Long\n    Dim lRes As Long\n    Dim lMsg As Long\n    Dim hr As Long\n    \n    If hwnd &amp;lt;&amp;gt; 0 Then\n        If Not IsIEServerWindow(hwnd) Then\n            ' \u67e5\u627e\u4e00\u4e2a WebBrowser \u63a7\u4ef6\u3002\n            EnumChildWindows hwnd, AddressOf EnumChildProc, hwnd\n        End If\n        ' \u6ce8\u518c\u6d88\u606f\u3002\n        lMsg = RegisterWindowMessage(\"WM_HTML_GETOBJECT\")\n        ' \u83b7\u53d6\u5bf9\u8c61\u7684\u6307\u9488\u3002\n        Call SendMessageTimeout(hwnd, lMsg, 0, 0, _\n        SMTO_ABORTIFHUNG, 1000, lRes)\n        If lRes Then\n            ' \u521d\u59cb\u5316\u63a5\u53e3 ID\u3002\n            With IID_IHTMLDocument\n                .Data1 = &amp;amp;H626FC520\n                .Data2 = &amp;amp;HA41E\n                .Data3 = &amp;amp;H11CF\n                .Data4(0) = &amp;amp;HA7\n                .Data4(1) = &amp;amp;H31\n                .Data4(2) = &amp;amp;H0\n                .Data4(3) = &amp;amp;HA0\n                .Data4(4) = &amp;amp;HC9\n                .Data4(5) = &amp;amp;H8\n                .Data4(6) = &amp;amp;H26\n                .Data4(7) = &amp;amp;H37\n            End With\n            ' \u5229\u7528\u6307\u9488 lRes \u83b7\u53d6 IHTMLDocument \u5bf9\u8c61\u3002\n            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)\n        End If\n    End If\nEnd Function\n\n'utilty function for getting the classname given a window handle\nFunction TheClassName(lhWnd As Long)\n    Dim strText As String, lngRet As Long\n    strText = String$(100, Chr$(0))\n    lngRet = GetClassName(lhWnd, strText, 100)\n    TheClassName = Left$(strText, lngRet)\nEnd Function\n\nPrivate Function GetHandleFromPartialCaption(ByRef lWnd As Long, _\n                                             ByVal sCaption As String) As Boolean\n    Dim lhWndP As Long, sStr As String\n\n    GetHandleFromPartialCaption = False\n    lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW\n    Do While lhWndP &amp;lt;&amp;gt; 0\n        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))\n        GetWindowText lhWndP, sStr, Len(sStr)\n        sStr = Left$(sStr, Len(sStr) - 1)\n        If Len(sStr) &amp;gt; 2 Then\n            If UCase(sStr) Like \"*ARG*\" Then Debug.Print sStr\n        End If\n        If InStr(1, sStr, sCaption) &amp;gt; 0 Then\n            GetHandleFromPartialCaption = True\n            lWnd = lhWndP\n            Exit Do\n        End If\n        lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)\n    Loop\nEnd Function\n\nPrivate Function IsIEServerWindow(ByVal hwnd As Long) As Boolean\n    Dim lRes As Long\n    Dim sClassName As String\n    ' \u521d\u59cb\u5316\u7f13\u51b2\u533a\u5927\u5c0f\u3002\n    sClassName = String$(255, 0)\n    ' \u83b7\u53d6 hWnd \u53e5\u67c4\u62e5\u6709\u8005\u7684\u7c7b\u540d\u79f0\u3002\n    lRes = GetClassName(hwnd, sClassName, Len(sClassName))\n    sClassName = Left$(sClassName, lRes)\n    IsIEServerWindow = StrComp(sClassName, _\n    \"Internet Explorer_Server\", _\n    vbTextCompare) = 0\nEnd Function\n\nFunction EnumChildProc(ByVal hwnd As Long, lParam As Long) As Long\n    If IsIEServerWindow(hwnd) Then\n        lParam = hwnd\n    Else\n        EnumChildProc = 1\n    End If\nEnd Function\n\n'\u901a\u8fc7\u521b\u5efavbs\u6765\u8fd0\u884c\u8868\u683c\u91cc\u9762\u7684\u5b8f\uff0c\u7528\u4e8e\u89e3\u51b3\u7f51\u9875\u6a21\u6001\u7a97\u53e3\u5bfc\u81f4\u5b8f\u6682\u505c\u95ee\u9898\nPrivate Sub vbsRunMacro(xlFullName As String, xlMacroName As String, parameter As String)\n    Dim vbsFullName As String, res As String\n    vbsFullName = Environ(\"temp\") &amp;amp; \"\\temp.vbs\"\n    Open vbsFullName For Output As #1\n    Print #1, \"Set xlApp = GetObject(, \"\"Excel.Application\"\")\" 'GetObject\u76f4\u63a5\u8c03\u7528\u5df2\u7ecf\u6253\u5f00\u7684thisworkbook\u91cc\u7684\u5b8f\n    Print #1, \"xlApp.Visible = True\"\n    Print #1, \"For Each xlBook In xlApp.Workbooks\"\n    Print #1, \"If xlBook.FullName = \"\"\" &amp;amp; xlFullName &amp;amp; \"\"\" Then\"\n    Print #1, \"Set oWorkbooks = xlBook\"\n    Print #1, \"xlApp.Run \"\"\" &amp;amp; xlMacroName &amp;amp; \"\"\", \"\"\" &amp;amp; parameter &amp;amp; \"\"\"\" '\u6839\u636e\u9700\u8981\u8c03\u6574\u5b8f\u7684\u540d\u79f0\"\n'    Print #1, \"xlApp.Quit\"\n    Print #1, \"End If\"\n    Print #1, \"Next\"\n    Print #1, \"Set oWorkbooks= nothing\"\n    Print #1, \"Set xlApp= nothing\"\n    Close #1\n'    ShellAndWait vbsFullName\n    Shell \"wscript.exe \" &amp;amp; vbsFullName\n    \n'    '\u5ef6\u65f6\u7b49\u5f85bat\u6267\u884c\u540e\u5220\u9664\u6587\u4ef6\n    Application.Wait (Now + TimeValue(\"0:00:01\"))\n    Kill vbsFullName\nEnd Sub\n\n'\u901a\u8fc7\u521b\u5efavbs\u6765\u53d1\u9001\u6309\u952e\uff0c\u7528\u4e8e\u89e3\u51b3\u7f51\u9875alert\u7a97\u53e3\u5bfc\u81f4\u5b8f\u6682\u505c\u95ee\u9898\n'\u89e3\u51b3ASP.net\u4ece\u670d\u52a1\u5668\u7aef\u5411\u5ba2\u6237\u7aef\u5f39\u51faalert\u5bf9\u8bdd\u6846\uff0c\u8fd9\u7c7b\u5f39\u7a97\u65e0\u6cd5\u901a\u8fc7\u91cd\u5199js alert\u6765\u5904\u7406\nPrivate Sub vbsSendKeys(oKeys As String)\n    Dim vbsFullName As String\n    vbsFullName = Environ(\"temp\") &amp;amp; \"\\temp.vbs\"\n    Open vbsFullName For Output As #1\n    Print #1, \"set wshshell = createobject(\"\"wscript.shell\"\")\"\n    Print #1, \"wscript.sleep 3500\"\n    Print #1, \"wshshell.sendkeys \" &amp;amp; oKeys\n    Print #1, \"Set wshshell= nothing\"\n    Close #1\n'    ShellAndWait vbsFullName\n    Shell \"wscript.exe \" &amp;amp; vbsFullName\n    \n    '\u5ef6\u65f6\u7b49\u5f85bat\u6267\u884c\u540e\u5220\u9664\u6587\u4ef6\n    Application.Wait (Now + TimeValue(\"0:00:01\"))\n    Kill vbsFullName\nEnd Sub\n\nPrivate Sub DialogPerson(vendor_person As String)\n    Const DLG_TITLE = \"\u7a97\u53e3title\" '&amp;lt;&amp;lt; the dialog title\n    Dim doc As IHTMLDocument\n    \n    Application.Wait (Now + TimeValue(\"0:00:01\")) '\u7b49\u5f85\u5f39\u7a97\n    Set doc = GetIEDialogDocument(DLG_TITLE)\n\n    If Not doc Is Nothing Then\n        doc.getElementById(\"txtName\").Value = vendor_person '&amp;lt;&amp;lt;\u586b\u5199\u5b50\u9875\u9762\u5f39\u7a97\u5185\u7684\u8868\u5355\n        ......\n        vbsSendKeys \"\"\"{enter}\"\"\" '\u8c03\u7528vbs\u53d1\u9001\u56de\u8f66\u952e\u5173\u95ed\u5b50\u7a97\u53e3\u7684alert\u5f39\u7a97\n        doc.getElementById(\"btnSave\").Click '\u70b9\u51fb\u6309\u94ae\uff0c\u8c03\u51faalert\u5f39\u7a97\n    Else\n        Debug.Print \"Dialog Window '\" &amp;amp; DLG_TITLE &amp;amp; \"' was not found!\", vbOKOnly + vbExclamation\n    End If\n    Set doc = Nothing\nEnd Sub\n\n'\u586b\u5199\u8868\u5355\u7684\u7a0b\u5e8f\nPrivate Sub enterPage(vendor_person As String, ...)\n    myURL = \"http:\/\/....\"\n    With CreateObject(\"internetexplorer.application\")\n        .Visible = True\n        .navigate myURL\n        Do Until .readyState = 4: DoEvents: Loop\n        Application.Wait (Now + TimeValue(\"0:00:01\")) '\u7b49\u5f85\u786e\u4fdd\u9875\u9762\u5b8c\u5168\u6253\u5f00\n        vbsRunMacro ThisWorkbook.FullName, \"DialogPerson\", vendor_person '\u8c03\u7528vbs\u6253\u5f00\u5b50\u9875\u9762\u5f39\u7a97\n        ......\n        End With      \n    End With    \nEnd Sub\n\n\u2019\u4e3b\u7a0b\u5e8f\nSub main()\n    enterPage Cells(i, \"A\")...\nEnd Sub<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>\u89e3\u51b3\u7f51\u9875\u6a21\u6001\u7a97\u53e3\u5bfc\u81f4VBA\u7a0b\u5e8f\u7b49\u5f85\u7684\u95ee\u9898&#8230; <\/p>\n","protected":false},"author":1,"featured_media":3304,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_monsterinsights_skip_tracking":false,"_monsterinsights_sitenote_active":false,"_monsterinsights_sitenote_note":"","_monsterinsights_sitenote_category":0,"footnotes":""},"categories":[40],"tags":[36,49,75,76,77],"class_list":["post-3303","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-vba","tag-vba","tag-49","tag-75","tag-76","tag-77"],"_links":{"self":[{"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/posts\/3303","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=3303"}],"version-history":[{"count":7,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/posts\/3303\/revisions"}],"predecessor-version":[{"id":3552,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/posts\/3303\/revisions\/3552"}],"wp:featuredmedia":[{"embeddable":true,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=\/wp\/v2\/media\/3304"}],"wp:attachment":[{"href":"https:\/\/www.bytetape.com\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=3303"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=3303"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.bytetape.com\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=3303"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}