Excel VBA dành cho IE8
CHÀO
Tôi đang cố gắng tạo trang đăng nhập bằng mật khẩu thông qua VBA. Trước khi nâng cấp trình duyệt IE, mọi thứ hoạt động tốt. Giờ tôi đang dùng IE8.
Đặt objIE = CreateObject("InternetExplorer.Application")
objIE.Toolbar = False
objIE.Resizable = True
objIE.StatusBar = False
objIE.FullScreen = True
objIE.width = 275
objIE.height = 230
Tôi không thể thu nhỏ kích thước trang do objIE.FullScreen = True.
Có ai có thể giúp tôi không?
Trả lời:
Có lý do nào khiến bạn phải đặt objIE.FullScreen = True không? Bạn không thể đặt nó thành False, hoặc bỏ hẳn đi được sao?
Eric
Trả lời:
Lý do là vì tôi không muốn hiển thị chú thích trên trình duyệt (bao gồm biểu tượng IE, các nút điều khiển của IE như nút đóng, thu nhỏ và phóng to).
Trả lời:
Đây là đoạn mã...
Nếu bạn đang sử dụng phiên bản IE8 cũ hơn, nó hoạt động hoàn hảo...
Sub test()
'Tạo một đối tượng IE'
Đặt objIE = CreateObject("InternetExplorer.Application")
'Chỉ định một số cài đặt của cửa sổ IE'
objIE.Navigate "about:blank"
'Đang chờ ra mắt.'
Ứng dụng.Màn hình cập nhật = Sai
Application.WaitNow() + TimeValue("00:00:01")
objIE.Visible = True
objIE.Silent = False
objIE.Document.Title = "Thay đổi mật khẩu" & String(100, Chr(160))
objIE.Toolbar = False
objIE.Resizable = True
objIE.StatusBar = False
'objIE.FullScreen = True
objIE.Width = 275
objIE.Height = 230
'Căn giữa cửa sổ thoại trên màn hình'
Với objIE.Document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width) \ 2
objIE.Top = (.availHeight - objIE.Height) \ 2
Kết thúc bằng
'Chờ đến khi IE sẵn sàng'
Thực hiện vòng lặp while objIE.Busy
Vòng lặp
Chèn mã HTML để yêu cầu người dùng nhập thông tin
Với objIE
.Document.body.innerHTML = "<div align=""center""><table cellspacing=""1"">" _
& "<th colspan=""1"">" & windowTitle & "</th></table></div>" _
& "<P><label style=color:black; size:10; font-family:arial; text-align:center>ID người dùng:" & Chr(160) & Chr(160) & Chr(160) & Chr(160) & "</label>" _
& "<INPUT TYPE='Tên đăng nhập' SIZE= '13' ID='Tên đăng nhập'></P>" _
& "<label style=color:black; size:10; font-family:arial; text-align:center>Mật khẩu: </label>" _
& "<INPUT TYPE='password' SIZE= '15'ID='Password'></P>" _
& "</div><div align="center"><P><INPUT TYPE='hidden' ID='Login' NAME='Login' VALUE='0'>" _
& "<INPUT TYPE='button' VALUE=' Done ' OnClick='VBScript:Login.Value=1'>" & vbCrLf & vbCrLf _
& "<INPUT TYPE='hidden' ID='Cancel' NAME='Cancel' VALUE='1'>" _
& "<INPUT TYPE='button' VALUE='Cancel' OnClick='VBScript:Cancel.Value=0'>" _
& "</P></DIV>"
'Thay đổi màu sắc'
.Document.body.Style.backgroundColor = "#AAAAAA"
'Ẩn thanh cuộn'
.Document.body.Style.overflow = "auto"
Kết thúc bằng
'Hãy làm cho cửa sổ hiển thị
objIE.Visible = True
'Đặt tiêu điểm vào trường nhập mật khẩu'
objIE.Document.All.Password.Focus
'Chờ đến khi nút OK được nhấn'
Thực thi vòng lặp while objIE.Document.All.Login.Value = 0
'Nếu nút 'Hủy' được nhấn...
Nếu objIE.Document.All.Cancel.Value = 0 thì Thoát
DoEvents
Nếu có lỗi thì thoát thực hiện 'người dùng đã nhấp vào dấu X màu đỏ (hoặc alt-F4) để đóng cửa sổ IE'
Vòng lặp
objIE.Quit
Đặt objIE = Nothing
End Sub
Trả lời:
Thêm đoạn mã bên dưới vào một mô-đun trong dự án VB của bạn. Sau đó, thay đổi mã của bạn từ đoạn mã này:
'Hãy làm cho cửa sổ hiển thị
objIE.Visible = True
'Đặt tiêu điểm vào trường nhập mật khẩu'
objIE.Document.All.Password.Focus
Cụ thể như sau:
'Hãy làm cho cửa sổ hiển thị
Gọi Title_Hide(objIE.hwnd)
objIE.Visible = True
'Đặt tiêu điểm vào trường nhập mật khẩu'
objIE.Document.All.Password.Focus
HTH,
Eric
======= BẮT ĐẦU MÃ =========
Tùy chọn rõ ràng
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000
Private Declare Function SetWindowPos Lib "user32" _
(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
Enum riêng tư ESetWindowPosStyles
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_FRAMECHANGED = &H20
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200
SWP_NOREDRAW = &H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
End Enum
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Loại riêng tư RECT
Để lại càng lâu càng tốt
Cao nhất là lâu
Đúng vậy, miễn là
Dưới cùng dài
Loại cuối
Sub Title_Show(xlhnd As Long)
Gọi ShowTitleBar(True, xlhnd)
End Sub
Ẩn tiêu đề phụ (xlhnd As Long)
Gọi ShowTitleBar(False, xlhnd)
End Sub
Sub ShowTitleBar(bShow As Boolean, xlhnd As Long)
Dim lStyle As Long
Dim tRect As RECT
Dim sWndTitle As String
'Dim xlhnd
'// Lấy vị trí của cửa sổ:
GetWindowRect xlhnd, tRect
'// Hiển thị thanh tiêu đề ?
Nếu không hiển thị thì
lStyle = GetWindowLong(xlhnd, GWL_STYLE)
lStyle = lStyle Và không phải WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle Và không phải WS_CAPTION
Khác
lStyle = GetWindowLong(xlhnd, GWL_STYLE)
lStyle = lStyle Hoặc WS_SYSMENU
lStyle = lStyle Hoặc WS_MAXIMIZEBOX
lStyle = lStyle Hoặc WS_MINIMIZEBOX
lStyle = lStyle Hoặc WS_CAPTION
Kết thúc nếu
SetWindowLong xlhnd, GWL_STYLE, lStyle
Application.DisplayFullScreen = Not bShow
'// Đảm bảo kiểu dáng được thiết lập và làm cho xlwindow trở thành
'// cùng kích thước, bất kể thanh tiêu đề.
SetWindowPos xlhnd, 0, tRect.Left, tRect.Top, tRect.Right - tRect.Left, _
tRect.Bottom - tRect.Top, SWP_NOREPOSITION Hoặc SWP_NOZORDER Hoặc SWP_FRAMECHANGED
End Sub
======= KẾT THÚC MÃ =========
Trả lời:
Tuyệt vời! Cảm ơn bạn đã giúp đỡ.
Trả lời:
Có cách nào để hiển thị cửa sổ thông báo (cửa sổ bật lên khi đăng nhập Windows - nếu phím Caps Lock đang bật) khi phím Caps Lock đang bật hoặc phím Num Lock đang tắt không?
Trả lời:
Có cách nào để hiển thị cửa sổ thông báo (cửa sổ bật lên khi đăng nhập Windows - nếu phím Caps Lock đang bật) khi phím Caps Lock đang bật hoặc phím Num Lock đang tắt không?
Trả lời:
Ví dụ bên dưới không hiển thị cửa sổ thông báo dạng bong bóng. Thay vào đó, nó chỉ thay đổi mã HTML của cửa sổ để thêm hoặc xóa các nhãn cảnh báo.
Thêm một mô-đun khác bao gồm đoạn mã bên dưới ("BEGIN NEW CODE") để kiểm tra trạng thái của các phím Capslock và Numlock. Sau đó, trong mã HTML của cửa sổ mật khẩu, hãy thêm một vài nhãn bổ sung:
"CAPSLOCK ĐANG BẬT!" và "NUMLOCK ĐANG TẮT!". Bên trong vòng lặp chính để lấy tên người dùng và mật khẩu, hãy kiểm tra xem trạng thái nào đúng, và bật hoặc tắt các nhãn đó bằng cách thay đổi HTML của cửa sổ.
Tôi đã sửa đổi mã gốc của bạn ("BEGIN MODIFIED CODE") để minh họa cách thức hoạt động của nó.
HTH,
Eric
======= BẮT ĐẦU MÃ MỚI =========
Tùy chọn rõ ràng
'Hãy đặt những khai báo này ở đầu mô-đun.
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const kCapital = 20
Private Const kNumlock = 144
Public Function CapsLock() As Boolean
CapsLock = KeyState(kCapital)
Kết thúc hàm
Hàm công khai NumLock() kiểu Boolean
NumLock = KeyState(kNumlock)
Kết thúc hàm
Hàm riêng tư KeyState(lKey As Long) As Boolean
KeyState = CBool(GetKeyState(lKey))
Kết thúc hàm
======== KẾT THÚC MÃ ========
======= BẮT ĐẦU ĐOẠN MÃ ĐÃ SỬA ĐỔI =========
Tùy chọn rõ ràng
Public objIE As Object
Tiêu đề cửa sổ công khai dưới dạng chuỗi
Sub test()
Khai báo html1 là chuỗi, html2 là chuỗi, html3 là chuỗi, html4 là chuỗi
' Không dùng phím CAPSLOCK hoặc NUMLOCK
html1 = "<div align=""center""><table cellspacing=""1"">" _
& "<th colspan=""1"">" & windowtitle & "</th></table></div>" _
& "<P><label style=color:black; size:10; font-family:arial; text-align:center>ID người dùng:" & Chr(160) & Chr(160) & Chr(160) & Chr(160) & "</label>" _
& "<INPUT TYPE='Tên đăng nhập' SIZE= '13' ID='Tên đăng nhập'></P>" _
& "<label style=color:black; size:10; font-family:arial; text-align:center>Mật khẩu: </label>" _
& "<INPUT TYPE='password' SIZE= '15'ID='Password'></P>" _
& "</div><div align="center"><P><INPUT TYPE='hidden' ID='Login' NAME='Login' VALUE='0'>" _
& "<INPUT TYPE='button' VALUE=' Done ' OnClick='VBScript:Login.Value=1'>" & vbCrLf & vbCrLf _
& "<INPUT TYPE='hidden' ID='Cancel' NAME='Cancel' VALUE='1'>" _
& "<INPUT TYPE='button' VALUE='Cancel' OnClick='VBScript:Cancel.Value=0'>" _
& "</P>" _
& "</DIV>"
' Chế độ CAPSLOCK đang bật'
html2 = "<div align=""center""><table cellspacing=""1"">" _
& "<th colspan=""1"">" & windowtitle & "</th></table></div>" _
& "<P><label style=color:black; size:10; font-family:arial; text-align:center>ID người dùng:" & Chr(160) & Chr(160) & Chr(160) & Chr(160) & "</label>" _
& "<INPUT TYPE='Tên đăng nhập' SIZE= '13' ID='Tên đăng nhập'></P>" _
& "<label style=color:black; size:10; font-family:arial; text-align:center>Mật khẩu: </label>" _
& "<INPUT TYPE='password' SIZE= '15'ID='Password'></P>" _
& "</div><div align="center"><P><INPUT TYPE='hidden' ID='Login' NAME='Login' VALUE='0'>" _
& "<INPUT TYPE='button' VALUE=' Done ' OnClick='VBScript:Login.Value=1'>" & vbCrLf & vbCrLf _
& "<INPUT TYPE='hidden' ID='Cancel' NAME='Cancel' VALUE='1'>" _
& "<INPUT TYPE='button' VALUE='Cancel' OnClick='VBScript:Cancel.Value=0'>" _
& "</P>" _
& "<P><label style=color:red; size:8; font-family:arial; text-align:center>ĐANG BẬT CHẾ ĐỘ VIẾT HOA!!!</P>" _
& "</DIV>"
'NUMLOCK ĐANG TẮT'
html3 = "<div align="center"><table cellspacing="1"">" _
& "<th colspan=""1"">" & windowtitle & "</th></table></div>" _
& "<P><label style=color:black; size:10; font-family:arial; text-align:center>ID người dùng:" & Chr(160) & Chr(160) & Chr(160) & Chr(160) & "</label>" _
& "<INPUT TYPE='Tên đăng nhập' SIZE= '13' ID='Tên đăng nhập'></P>" _
& "<label style=color:black; size:10; font-family:arial; text-align:center>Mật khẩu: </label>" _
& "<INPUT TYPE='password' SIZE= '15'ID='Password'></P>" _
& "</div><div align="center"><P><INPUT TYPE='hidden' ID='Login' NAME='Login' VALUE='0'>" _
& "<INPUT TYPE='button' VALUE=' Done ' OnClick='VBScript:Login.Value=1'>" & vbCrLf & vbCrLf _
& "<INPUT TYPE='hidden' ID='Cancel' NAME='Cancel' VALUE='1'>" _
& "<INPUT TYPE='button' VALUE='Cancel' OnClick='VBScript:Cancel.Value=0'>" _
& "</P>" _
& "<P><label style=color:red; size:8; font-family:arial; text-align:center>PHÍM NUM LOCK ĐÃ TẮT!!!</P>" _
& "</DIV>"
' Chế độ CAPSLOCK đang bật và chế độ NUMLOCK đang tắt'
html4 = "<div align=""center""><table cellspacing=""1"">" _
& "<th colspan=""1"">" & windowtitle & "</th></table></div>" _
& "<P><label style=color:black; size:10; font-family:arial; text-align:center>ID người dùng:" & Chr(160) & Chr(160) & Chr(160) & Chr(160) & "</label>" _
& "<INPUT TYPE='Tên đăng nhập' SIZE= '13' ID='Tên đăng nhập'></P>" _
& "<label style=color:black; size:10; font-family:arial; text-align:center>Mật khẩu: </label>" _
& "<INPUT TYPE='password' SIZE= '15'ID='Password'></P>" _
& "</div><div align="center"><P><INPUT TYPE='hidden' ID='Login' NAME='Login' VALUE='0'>" _
& "<INPUT TYPE='button' VALUE=' Done ' OnClick='VBScript:Login.Value=1'>" & vbCrLf & vbCrLf _
& "<INPUT TYPE='hidden' ID='Cancel' NAME='Cancel' VALUE='1'>" _
& "<INPUT TYPE='button' VALUE='Cancel' OnClick='VBScript:Cancel.Value=0'>" _
& "</P>" _
& "<P><label style=color:red; size:8; font-family:arial; text-align:center>ĐANG BẬT CHẾ ĐỘ VIẾT HOA!!!</P>" _
& "<P><label style=color:red; size:8; font-family:arial; text-align:center>PHÍM NUM LOCK ĐÃ TẮT!!!</P>" _
& "</DIV>"
'Tạo một đối tượng IE'
Đặt objIE = CreateObject("InternetExplorer.Application")
'Chỉ định một số cài đặt của cửa sổ IE'
objIE.Navigate "about:blank"
'Đang chờ ra mắt.'
Ứng dụng.Màn hình cập nhật = Sai
Application.WaitNow() + TimeValue("00:00:01")
objIE.Visible = True
objIE.Silent = False
objIE.document.Title = "Thay đổi mật khẩu" & String(100, Chr(160))
objIE.Toolbar = False
objIE.Resizable = True
objIE.StatusBar = False
'objIE.FullScreen = True
objIE.Width = 275
objIE.Height = 250
'Căn giữa cửa sổ thoại trên màn hình'
Với objIE.document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width) \ 2
objIE.Top = (.availHeight - objIE.Height) \ 2
Kết thúc bằng
'Chờ đến khi IE sẵn sàng'
Thực hiện vòng lặp while objIE.Busy
Vòng lặp
Chèn mã HTML để yêu cầu người dùng nhập thông tin
Với objIE
.document.body.innerhtml = html1
'Thay đổi màu sắc'
.document.body.Style.backgroundColor = "#AAAAAA"
'Ẩn thanh cuộn'
.document.body.Style.overflow = "hidden"
Kết thúc bằng
'Hãy làm cho cửa sổ hiển thị
Gọi Title_Hide(objIE.hwnd)
objIE.Visible = True
'Đặt tiêu điểm vào trường nhập mật khẩu'
objIE.document.All.Password.Focus
'Chờ đến khi nút OK được nhấn'
Thực thi vòng lặp while objIE.document.All.Login.Value = 0
'Nếu nút 'Hủy' được nhấn...
Nếu objIE.document.All.Cancel.Value = 0 thì Thoát
Nếu (CapsLock) thì
Nếu (Không phải NumLock) thì
objIE.document.body.innerhtml = html4
Khác
objIE.document.body.innerhtml = html2
Kết thúc nếu
Khác
Nếu (Không phải NumLock) thì
objIE.document.body.innerhtml = html3
Khác
objIE.document.body.innerhtml = html1
Kết thúc nếu
Kết thúc nếu
DoEvents
Gọi Application.Wait(Now + TimeValue("0:00:01"))
Nếu có lỗi thì thoát thực hiện 'người dùng đã nhấp vào dấu X màu đỏ (hoặc alt-F4) để đóng cửa sổ IE'
Vòng lặp
objIE.Quit
Đặt objIE = Nothing
Application.DisplayFullScreen = False
End Sub
======= KẾT THÚC ĐOẠN MÃ ĐÃ SỬA ĐỔI =========
Trả lời:
Tôi đã sử dụng một kỹ thuật khác để chứng minh điều này.
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Và
TextOut GetWindowDC(GetActiveWindow), 50, 50, "Đây là một biểu mẫu", 14
trong tiểu
Phương pháp này có một số hạn chế. Tôi thích ý tưởng của bạn. Tôi sẽ áp dụng kỹ thuật này.
Cảm ơn sự giúp đỡ của bạn.
Trả lời:
Không có gì.
Comments
Post a Comment