Dùng cách khác để check vào Trust Access...Mình mở cửa sổ VBA ra thế này nhưng không biết làm sao đóng lại. Nhờ các anh chị hướng dẫn dùm
PHP:Sub Trigger() Application.CommandBars.FindControl(ID:=3627).Execute End Sub
Sub Test()
Dim oshell As Object
Set oshell = CreateObject("WScript.Shell")
oshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Excel\Security\AccessVBOM", 1, "REG_DWORD"
Set oshell = Nothing
End Sub
Mình mở cửa sổ VBA ra thế này nhưng không biết làm sao đóng lại. Nhờ các anh chị hướng dẫn dùm
PHP:Sub Trigger() Application.CommandBars.FindControl(ID:=3627).Execute End Sub
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const GW_HWNDNEXT = 2
Function CloseWindow(ByVal WinCap As String)
Dim hWnd As Long
Dim sTitle As String
hWnd = FindWindow(vbNullString, vbNullString)
Do While hWnd <> 0
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWnd, sTitle, Len(sTitle)))
If sTitle Like WinCap Then
SendMessage hWnd, &H10, 0&, 0&
Exit Function
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
End Function
Sub Main()
Const WinCap = "Trust Center"
CloseWindow WinCap
End Sub
Sub Auto_Open()
Dim bChk As Boolean
bChk = IsVBATrusted
If bChk = False Then ChangeVBOM
CheckReference
MsgBox bChk
End Sub
Sub CheckReference()
On Error Resume Next
Dim Script As String, VBIDE As String, AdoRef As String
Script = "{420B2830-E718-11CF-893D-00A0C9054228}"
VBIDE = "{0002E157-0000-0000-C000-000000000046}"
AdoRef = "{B691E011-1797-432E-907A-4D8C69339129}"
ThisWorkbook.VBProject.References.AddFromGuid Script, 1, 0
ThisWorkbook.VBProject.References.AddFromGuid AdoRef, 6, 0
ThisWorkbook.VBProject.References.AddFromGuid VBIDE, 5, 3
End Sub
Sub ChangeVBOM()
Dim regKey As String
regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" _
& Application.Version & "\Excel\Security\AccessVBOM"
CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
End Sub
Function IsVBATrusted() As Boolean
Application.Volatile
On Error Resume Next
IsVBATrusted = Not ThisWorkbook.VBProject Is Nothing
End Function
Sub Trigger()
Application.CommandBars.FindControl(ID:=3627).Execute
End Sub
Đã có ghi thì phải có đọc. Bạn chỉ cần đọc trong registry xem coi nó đã được đánh dấu kiểm hay chưa, nếu chưa (Giá trị là 0) thì lúc đó bạn đánh dấu vào (Giá trị là 1)Sự cố mình đang gặp là thế này. Theo dòng chảy của code thì khi mở file lên thì Sub Auto sẽ kích hoạt.
Sub này sẽ kiểm tra Trust Access và chạy Sub ChangeVBOM. Mặc dù kiểm tra thủ công sẽ thấy mục Trust Access được checked rồi nhưng code không hiểu nên không thể nào thực hiện được Sub CheckReference
và biến bChk sẽ luôn là False nếu ta không mở cửa sổ Trust Access lên.
Nhưng nếu ta dùng code này để mở cửa sổ Trust Access lên rồi bấm chọn OK thì mọi thứ hoạt độngPHP:Sub Auto_Open() Dim bChk As Boolean bChk = IsVBATrusted If bChk = False Then ChangeVBOM CheckReference MsgBox bChk End Sub Sub CheckReference() On Error Resume Next Dim Script As String, VBIDE As String, AdoRef As String Script = "{420B2830-E718-11CF-893D-00A0C9054228}" VBIDE = "{0002E157-0000-0000-C000-000000000046}" AdoRef = "{B691E011-1797-432E-907A-4D8C69339129}" ThisWorkbook.VBProject.References.AddFromGuid Script, 1, 0 ThisWorkbook.VBProject.References.AddFromGuid AdoRef, 6, 0 ThisWorkbook.VBProject.References.AddFromGuid VBIDE, 5, 3 End Sub Sub ChangeVBOM() Dim regKey As String regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" _ & Application.Version & "\Excel\Security\AccessVBOM" CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD" End Sub Function IsVBATrusted() As Boolean Application.Volatile On Error Resume Next IsVBATrusted = Not ThisWorkbook.VBProject Is Nothing End Function
Cho nên file đính kèm khi mở lên lúc nào cũng thông báo tình trạng là FalsePHP:Sub Trigger() Application.CommandBars.FindControl(ID:=3627).Execute End Sub
File trước đính kèm bị nhầm. Các anh chị xem lại file này.
Sub Auto_Open()
Dim regKey As String
regKey = "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\OFFICE\" & Application.Version & "\Excel\Security\AccessVBOM"
With CreateObject("WScript.Shell")
If .regRead(regKey) = 0 Then .RegWrite regKey, 1, "REG_DWORD"
End With
End Sub
Cũng vậy anh ơi.Kiểm tra xem vậy hết tức chưa?
Mình nghĩ Hải chưa test thử file mình!!!Cũng vậy anh ơi.
Thử vầy nhé. Mở file lên. Tắt các mục đánh dấu trong reference, vào excel option, bỏ check Trust Access, chọn ok. Đóng file lại, và mở lên thì không thể tự động được nữa.
Sub GetTrustAccess()
ChangeVBOM
If Application.Wait(Now + TimeValue("00:00:01") / 100000) Then SendKeys "{ENTER}"
Application.CommandBars.ExecuteMso ("MacroSecurity")
End Sub
Tạm thời tìm ra 1 giải pháp, hơi kỳ cục nhưng cũng tạm coi là 1 cách hay khi chưa có cách khác.
Dùng cái này thì đóng được cái cửa sổ Trust Access
PHP:Sub GetTrustAccess() ChangeVBOM If Application.Wait(Now + TimeValue("00:00:01") / 100000) Then SendKeys "{ENTER}" Application.CommandBars.ExecuteMso ("MacroSecurity") End Sub
Sub Auto_Close() Dim strRegKeyName As String
'Ver = Excel.Application.Version
strRegKeyName = "Software\Microsoft\Office\" & Excel.Application.Version & "\Excel\Security"
[COLOR=#ff0000] Call SetKeyDataValue(lngRegKey1ROOT, strRegKeyName, lngKeyDataType, strKeyAccessVBOMName, 0)[/COLOR]
[COLOR=#ff0000] DeleteRegValue lngRegKey1ROOT, strRegKeyName, strKeyAccessVBOMName[/COLOR]
End Sub
Các anh em dành tí thời gian test giúp theo trình tự sau xem coi tình trạng có giống như mình bị hay không
- Mở file của bài 7 lên. Lúc này tình trạng có thể là True hoặc False.
- Vào cửa sổ VBE, chọn Tools, Reference và bỏ chọn 3 mục (nếu có): Microsoft Visual Basic for Applications Extensibility, Microsoft Scripting Runtime, Microsoft AtiveX Data >>>Ok
- Vào Excel Options, Trust Center > Trust Center Setting > Macro Settings, bỏ chọn Trust Access >>> Ok
- Bây giờ vào lại VBE và thử kích hoạt Sub Aut
pen. Theo mong đợi thì sẽ xuất hiện thông báo True nhưng luôn xuất hiện thông báo False và khi kiểm tra các mục Reference (tại 2) thì các mục này chưa được đánh dấu chọn.
- Nhưng nếu bây giờ ta vào Excel Option để kiểm tra thì thấy mục Trust Access đã được đánh dấu chọn rồi. Nếu ta chọn Ok để thoát thì lúc này Sub Auto sẽ chạy ào ào, nhưng nếu ta thoát của sổ này bằng phím Cancel thì Sub Auto vẫn tình trạng cũ.
Ặc ặc, sao tình hình này giống như đang rờ voi quá...em test tới test lui đâu có gì mới đâu ngoài báo True và False thôi
nếu tích vào Trust Access trước thì báo là True và ngược lại là False
Ặc ặc, sao tình hình này giống như đang rờ voi quá...
Đã nói là không tick vào Trust Access mà... đang muốn cho nó tick tự động. Cho nên mới cần là bỏ tick ra trước rồi mới test code xem coi có báo true được hay không mà.