[Hỏi] Xem được code vba có pass trong file của mình = VBA (chỉ mình biết pass) (1 người xem)

campha · 24/7/13

Chào các bạn!

Mình có file test.xls đã đặt pass VBA = quangninh

Mình muốn hỏi có thể viết code VBA như thế nào
vi dụ hiện 1 inputbox để có thể điền pass "quangninh" & mở project tiếp tục viết code không? (lười 1 tí vì làm = tay qua nhiều thao tác: Alt+ F11 => nháy kép vào VBAProject => điền pass => OK)

code để phục vụ cho mình và khoá pass VBA dành người trình độ còn thấp thôi chứ mấy trò này sao qua mặt được các sư phụ.
Mong mọi người chỉ dẫn.

campha · 24/7/13

áp dụng code này thế nào

Mình vừa tìm được trên trang

HTML:

http://www.ozgrid.com/forum/showthread.php?t=13006&p=65776#post65776

nhưng báo lỗi.

Mọi người thử xem có khả thi không ?(CHỖ MÀU ĐỎ LÀ NTN?)

Mã:

[COLOR=#ff0000][B]'need reference To VBA Extensibility [/B][/COLOR]
'need To make sure that the target project Is the active project 
[B]
Sub test() [/B]
    UnprotectVBProject Workbooks("ABook.xls"), "password" 
End Sub 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

[B]Sub UnprotectVBProject(WB As Workbook, ByVal Password As String) [/B]
    ' 
   [COLOR=#0000cd] [SIZE=3]' Bill Manville, 29-Jan-2000 [/SIZE][/COLOR]
    ' 
    Dim VBP As VBProject, oWin As VBIDE.Window 
    Dim wbActive As Workbook 
    Dim i As Integer 
    
    Set VBP = WB.VBProject 
    Set wbActive = ActiveWorkbook 
    
    If VBP.Protection <> vbext_pp_locked Then Exit Sub 
    
    Application.ScreenUpdating = False 
    
    ' Close any code windows To ensure we hit the right project 
    For Each oWin In VBP.VBE.Windows 
        If InStr(oWin.Caption, "(") > 0 Then oWin.Close 
    Next oWin 
    
    WB.Activate 
    ' now use lovely SendKeys To unprotect 
    Application.OnKey "%{F11}" 
    SendKeys "%{F11}%TE" & Password & "~~%{F11}", True 
    
    If VBP.Protection = vbext_pp_locked Then 
        ' failed - maybe wrong password 
        SendKeys "%{F11}%TE", True 
    End If 
    
    ' leave no evidence of the password 
    Password = "" 
    ' go back To the previously active workbook 
    wbActive.Activate 
    
End Sub 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
[B]
Sub ProtectVBProject(WB As Workbook, ByVal Password As String) [/B]
    
    Dim VBP As VBProject, oWin As VBIDE.Window 
    Dim wbActive As Workbook 
    Dim i As Integer 
    
    Set VBP = WB.VBProject 
    Set wbActive = ActiveWorkbook 
    
    ' Close any code windows To ensure we hit the right project 
    For Each oWin In VBP.VBE.Windows 
        If InStr(oWin.Caption, "(") > 0 Then oWin.Close 
    Next oWin 
    
    WB.Activate 
    ' now use lovely SendKeys To unprotect 
    Application.OnKey "%{F11}" 
    SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~" 
    Application.VBE.CommandBars(1).FindControl(Id:=2578, recursive:=True).Execute 
    WB.Save 
End Sub 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

hoi_joker · 24/7/13

Thử cách này

Mã:

Sub UnprotectVBAProject()

On Error GoTo ErrHandler
Const conPW as String = "[COLOR=#ff0000]quangninh[/COLOR]"

Call SendKeys("%{F11}", True)

Call SendKeys("%(V)P", True)

[COLOR=#0000cd]Call SendKeys("{PGUP 5}", True)[/COLOR]

Call SendKeys("{ENTER}" & conPW & "{ENTER}", True)

ExitProcedure:
Exit Sub

ErrHandler:
Select Case Err.Number
Case Else
Application.ScreenUpdating = True
MsgBox Err.Number & vbNewLine & Err.Description,
vbCritical
Resume ExitProcedure
Resume
End Select

End Sub

ndu96081631 · 24/7/13

campha đã viết:
Mình vừa tìm được trên trang

HTML:

http://www.ozgrid.com/forum/showthread.php?t=13006&p=65776#post65776

nhưng báo lỗi.

Mọi người thử xem có khả thi không ?(CHỖ MÀU ĐỎ LÀ NTN?)

Mã:

'[COLOR=#ff0000]need reference To VBA Extensibility[/COLOR]

Chổ màu đỏ nghĩa là:
- Trong cửa sổ VBA, bạn vào menu Tools\References
- Check mục "Microsoft Visual Basic for Application Extensibility.... "
--------------
Nói chung hiện nay chưa có cách nào can thiệp 1 cách toàn diện vào VBA Project để tạo hoặc xóa password nên người ta phải dùng cách SendKeys ---> Dở ẹc

hoi_joker · 25/7/13

hoi_joker đã viết:

Thử cách này

Mã:

Sub UnprotectVBAProject()

On Error GoTo ErrHandler
Const conPW as String = "[COLOR=#ff0000]quangninh[/COLOR]"

Call SendKeys("%{F11}", True)

Call SendKeys("%(V)P", True)

[COLOR=#0000cd]Call SendKeys("{PGUP 5}", True)[/COLOR]

Call SendKeys("{ENTER}" & conPW & "{ENTER}", True)

ExitProcedure:
Exit Sub

ErrHandler:
Select Case Err.Number
Case Else
Application.ScreenUpdating = True
MsgBox Err.Number & vbNewLine & Err.Description,
vbCritical
Resume ExitProcedure
Resume
End Select

End Sub

Tình hình là mình có file abc.xls có pass VBA = abcdef
+ mình đã áp dụng code trên để mở pass VBA
+ kết hợp xóa code VBA (tất nhiên phải sau khi unlock VBAProject mới dùng được code của sư phụ siwtom ) để sau khi chạy xong code là xóa luôn, tránh những tay vớ vẩn lại thích tọc mạch ở cty

Mã:

Sub DeleteAllCodes()
Dim x
    On Error Resume Next
    With ActiveWorkbook.VBProject
        For x = .VBComponents.Count To 1 Step -1
            If .VBComponents(x).Type <> 100 Then
                .VBComponents.Remove .VBComponents(x)
            Else
                With .VBComponents(x).CodeModule
                    .DeleteLines 1, .CountOfLines
                End With
            End If
        Next x
    End With
End Sub

Vẫn còn thắc mắc:
1) Dùng Office 2003 thì chạy OK, các bạn test thử giúp 2007, 2010 ntn?
2) Dùng code nào để xóa/ "cut" luôn Command Button (ActiveX) & Command Button (Form)... trên sheet vì hiện tại sau khi xóa code VBA thì các control vẫn còn trên sheet, code tổng quát để xóa các Controls trên sheet nhé đừng bắt mình làm thủ công hặc nhớ tên các control vì nếu thế mình Record Macro là xong rồi

campha · 25/7/13

hoi_joker đã viết:
Tình hình là mình có file abc.xls có pass VBA = abcdef
+ mình đã áp dụng code trên để mở pass VBA
+ kết hợp xóa code VBA (tất nhiên phải sau khi unlock VBAProject mới dùng được code của sư phụ siwtom ) để sau khi chạy xong code là xóa luôn, tránh những tay vớ vẩn lại thích tọc mạch ở cty

Mã:

Sub DeleteAllCodes() Dim x On Error Resume Next With ActiveWorkbook.VBProject For x = .VBComponents.Count To 1 Step -1 If .VBComponents(x).Type <> 100 Then .VBComponents.Remove .VBComponents(x) Else With .VBComponents(x).CodeModule .DeleteLines 1, .CountOfLines End With End If Next x End With End Sub

Vẫn còn thắc mắc:
1) Dùng Office 2003 thì chạy OK, các bạn test thử giúp 2007, 2010 ntn?
2) Dùng code nào để xóa/ "cut" luôn Command Button (ActiveX) & Command Button (Form)... trên sheet vì hiện tại sau khi xóa code VBA thì các control vẫn còn trên sheet, code tổng quát để xóa các Controls trên sheet nhé đừng bắt mình làm thủ công hặc nhớ tên các control vì nếu thế mình Record Macro là xong rồi

Vd như thế này chăng

Mã:

 Sub DeleteObjects()
    ActiveSheet.DrawingObjects.Delete
End Sub

phanminhphuong · 26/7/13

Topic này khá phù hợp với yêu cầu của mình để trị mấy tay amatuer.

Mình có câu hỏi mong mọi người trợ giúp:

Bài #5 của hoi_joker khi dùng 2 sub "UnlockVBA" & "DeleteCode" riêng sau đó trong sub "DeleteCode" mới Call "UnlockVBA" thì chạy bình thường tại sao khi dồn và 01 sub "DeleteCode" thì lại bị lỗi & ko tiếp tục chạy hết CODE? phải chăng do sendkeys?

Mã:

' [I][B][COLOR=#ff0000]KẾT HỢP 2 SUB VÀO 1 THÌ KHÔNG THỰC HIỆN NỐT 2 ĐOẠN SAU (FILE ĐÍNH KÈM)[/COLOR][/B][/I]
Sub DeleteCode()
'[COLOR=#0000ff]====== unlock VBA ========================[/COLOR]
On Error GoTo ErrHandler
Const conPW As String = "abcdef"
 
Call SendKeys("%{F11}", True)
Call SendKeys("%(V)P", True)
Call SendKeys("{PGUP 5}", True)
Call SendKeys("{ENTER}" & conPW & "{ENTER}", True)
 
ExitProcedure:
 Exit Sub
 
ErrHandler:
 Select Case Err.Number
 Case Else
 Application.ScreenUpdating = True
 MsgBox Err.Number & vbNewLine & Err.Description, vbCritical
 Resume ExitProcedure
 Resume
 End Select
[COLOR=#0000ff]'=========================================[/COLOR]
'Delete code
Dim x
    On Error Resume Next
    With ActiveWorkbook.VBProject
        For x = .VBComponents.Count To 1 Step -1
            If .VBComponents(x).Type <> 100 Then
                .VBComponents.Remove .VBComponents(x)
            Else
                With .VBComponents(x).CodeModule
                    .DeleteLines 1, .CountOfLines
                End With
            End If
        Next x
    End With
[COLOR=#0000ff]'=============================================[/COLOR]
' Xóa Objects trên sheet
ActiveSheet.DrawingObjects.Delete
    
End Sub

phanminhphuong · 29/7/13

tham khảo

http://www.giaiphapexcel.com/forum/...g-vba-để-xóa-vba-đc-không&p=444901#post444901

http://www.siddharthrout.com/2013/0...ject-password-using-a-password-that-you-know/

http://www.cpearson.com/excel/vbe.aspx

[Hỏi] Xem được code vba có pass trong file của mình = VBA (chỉ mình biết pass) (1 người xem)

Người dùng đang xem chủ đề này

campha

Thành viên mới

campha

Thành viên mới

hoi_joker

Thành viên mới

ndu96081631

Huyền thoại GPE

hoi_joker

Thành viên mới

File đính kèm

campha

Thành viên mới

phanminhphuong

Thành viên hoạt động

File đính kèm

phanminhphuong

Thành viên hoạt động

Bài viết mới nhất

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

Thời gian đếm ngược.