乔山办公网我们一直在努力
您的位置:乔山办公网 > excel表格制作 > 使用VBA对一个打开的文档进行操作,代码~详细点!谢谢!

使用VBA对一个打开的文档进行操作,代码~详细点!谢谢!

作者:乔山办公网日期:

返回目录:excel表格制作


With IE

.navigate URL

.Visible = True

.document.forms(0).submit

End With

如果不是你想要的,说明目标网页不只有一个form,需要你去目标网页,点f12,找你想要的那个。当然你也可以通过更改forms(x)去一个个试,总能找到你要的那个。当然你也可以去找那个按钮的值,用按钮点击的方法。

ie.document.getElementById(按钮的值).click

ActiveSheet.WebBrowser1.Document.form1.Button1.Click

页面.webbrowser控件.网页.表单名.按钮名.点击



Private Sub iOpenXLS()
Dim ph As String, bk As Workbook
ph = "D:\我的文档\Book1.xls" '设置excel文件地址
Set bk = Workbooks.Open(ph) '打开这个excel文档
With bk.Worksheets("sheet1") '操作sheet表
.Range("a1:b1").Merge '合并单元格a1:b1
End With
bk.Close True '保存并关闭这个excel文件
End Sub
代码如下:
Sub s()
On Error Resume Next
Dim pth$, fn$, wb As Workbook
pth = "d:\test\" '在这里输入要打开的工作簿的完整路径
fn = "a.xlsx" '在这里输入要打开的工作簿的文件名,包括扩展名
Set wb = Application.Workbooks.Open(pth & fn)
If wb Is Nothing Then MsgBox ("文件打开失败,请检查" & pth & fn & "是否存在!"): Exit Sub
'在此添加操作代码
wb.Close True '如果无需保存,本参数用false
End Sub

'准备工作:1.用IE打开百度
          2.调用函数GetIE

'代码搜索标题包含百度的IE窗口,e69da5e6ba907a686964616f364然后控制打开hao123,最后保存为c:\myhtml.txt
Option Explicit
  '
  '   工程要引用  "Microsoft   HTML   Object   Library"
  '
    
Private Type UUID
      Data1   As Long
      Data2   As Integer
      Data3   As Integer
      Data4(0 To 7)       As Byte
End Type
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
      Alias "GetClassNameA" ( _
      ByVal hWnd As Long, _
      ByVal lpClassName As String, _
      ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
  
Private Declare Function RegisterWindowMessage Lib "user32" _
      Alias "RegisterWindowMessageA" ( _
      ByVal lpString As String) As Long
  
Private Declare Function SendMessageTimeout Lib "user32" _
      Alias "SendMessageTimeoutA" ( _
      ByVal hWnd As Long, _
      ByVal msg As Long, _
      ByVal wParam As Long, _
      lParam As Any, _
      ByVal fuFlags As Long, _
      ByVal uTimeout As Long, _
      lpdwResult As Long) As Long
              
Private Const SMTO_ABORTIFHUNG = &H2
  
Private Declare Function ObjectFromLresult Lib "oleacc" ( _
      ByVal lResult As Long, _
      riid As UUID, _
      ByVal wParam As Long, _
      ppvObject As Any) As Long
Dim IEhwnd As Long
Dim IEserver As Long
'
'   IEDOMFromhWnd
'
'   Returns   the   IHTMLDocument   interface   from   a   WebBrowser   window
'
'   hWnd   -   Window   handle   of   the   control
'
Function IEDOMFromhWnd() As IHTMLDocument
Dim IID_IHTMLDocument     As UUID
Dim hWnd   As Long
Dim lRes   As Long
Dim lMsg   As Long
Dim hr     As Long
    '   Find   a   child   IE   server   window
    EnumWindows AddressOf EnumWindowProc, ByVal 0
    If IEhwnd Then EnumChildWindows IEhwnd, AddressOf EnumChildProc, ByVal 0
    If IEserver Then hWnd = IEserver Else Exit Function
    
    '   Register   the   message
    lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
    '   Get   the   object   pointer
    Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
                    SMTO_ABORTIFHUNG, 1000, lRes)
    If lRes Then
          '   Initialize   the   interface   ID
          With IID_IHTMLDocument
                .Data1 = &H626FC520
                .Data2 = &HA41E
                .Data3 = &H11CF
                .Data4(0) = &HA7
                .Data4(1) = &H31
                .Data4(2) = &H0
                .Data4(3) = &HA0
                .Data4(4) = &HC9
                .Data4(5) = &H8
                .Data4(6) = &H26
                .Data4(7) = &H37
          End With
          '   Get   the   object   from   lRes
          hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
    End If
End Function
  
Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
Dim lRes     As Long
Dim sClassName     As String
    sClassName = GetClsName(hWnd)
    IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0
End Function
'返回窗口类名
Public Function GetClsName(ByVal hWnd As Long) As String
Dim lRes     As Long
Dim sClassName     As String
    sClassName = String$(200, 0)
    lRes = GetClassName(hWnd, sClassName, Len(sClassName))
    GetClsName = Left$(sClassName, lRes)
End Function
'返回窗口标题
Public Function GetWinTitle(ByVal lhWnd As Long) As String
    Dim MyStr As String
    MyStr = String(200, Chr$(0))
    GetWindowText lhWnd, MyStr, 200
    GetWinTitle = Left(MyStr, InStr(MyStr, Chr$(0)) - 1)
End Function
Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim sIEtitle As String
    sIEtitle = GetWinTitle(hWnd)
    If InStr(1, sIEtitle, "百度") Then  '搜索标题包含baidu的窗口
        IEhwnd = hWnd
    Else
        EnumWindowProc = 1
    End If
End Function
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
    If IsIEServerWindow(hWnd) Then
        IEserver = hWnd
    Else
        EnumChildProc = 1
    End If
End Function
Function GetIE() As Long
    Dim Doc As IHTMLDocument2
    Dim s As String
    Set Doc = IEDOMFromhWnd
    If Not Doc Is Nothing Then
        Doc.url = "http://" '打开网页
        Do Until Doc.readyState = "complete"
            DoEvents
        Loop
        s = Doc.body.innerHTML
        Open "c:\myhtml.txt" For Output As #1
        Print #1, s
        Close
    End If
End Function

相关阅读

关键词不能为空
极力推荐

ppt怎么做_excel表格制作_office365_word文档_365办公网