Có thể dùng vba để xóa vba đc không? (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Q

quykiemsau

Thành viên chính thức
Tham gia
4/8/10
Bài viết
66
Được thích
0
Em chào các anh chị!
Có code nào có thể test 1 điều kiện nào đó để xóa toàn bộ vba trong file Excel được không ạ?
Cụ thể là
ô A1! của sheet 1! em đặt điều kiện hoặc =0 hoặc =1.
Khi Open file:
ô a1=1 thì file chạy bình thường.
Nếu A1=0 thì toàn bộ vba trong file bị xóa sạch.
Có được không ạ?
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Tiếp
PHP: 
Sub Mcorrel(inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant)
    xMcorrel = Application.Run(GetMacroRegId("fnMCorrel"), inprng, outrng, grouped, labels)
End Sub

Sub McorrelQ(Optional inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant)
    xMcorrelQ = Application.Run(GetMacroRegId("fnMCorrelQ"), inprng, outrng, grouped, labels)
End Sub

Sub Mcovar(inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant)
    xMcovar = Application.Run(GetMacroRegId("fnMCovar"), inprng, outrng, grouped, labels)
End Sub

Sub McovarQ(Optional inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant)
    xMcovarQ = Application.Run(GetMacroRegId("fnMCovarQ"), inprng, outrng, grouped, labels)
End Sub

Sub Moveavg(inprng As Variant, Optional outrng As Variant, Optional interval As Variant, Optional stderrs As Variant, Optional chart As Variant, Optional labels As Variant)
    xMoveavg = Application.Run(GetMacroRegId("fnMoveAvg"), inprng, outrng, interval, stderrs, chart, labels)
End Sub

Sub MoveavgQ(Optional inprng As Variant, Optional outrng As Variant, Optional interval As Variant, Optional stderrs As Variant, Optional chart As Variant, Optional labels As Variant)
    xMoveavgQ = Application.Run(GetMacroRegId("fnMoveAvgQ"), inprng, outrng, interval, stderrs, chart, labels)
End Sub

Sub Pttestm(inprng1 As Variant, inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant)
    xPttestm = Application.Run(GetMacroRegId("fnTtestM"), inprng1, inprng2, outrng, labels, alpha, difference)
End Sub

Sub PttestmQ(Optional inprng1 As Variant, Optional inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant)
    xPttestmQ = Application.Run(GetMacroRegId("fnTtestMQ"), inprng1, inprng2, outrng, labels, alpha, difference)
End Sub

Sub Pttestv(inprng1 As Variant, inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant)
    xPttestv = Application.Run(GetMacroRegId("fnTtestUeq"), inprng1, inprng2, outrng, labels, alpha, difference)
End Sub

Sub PttestvQ(Optional inprng1 As Variant, Optional inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant)
    xPttestvQ = Application.Run(GetMacroRegId("fnTtestUeqQ"), inprng1, inprng2, outrng, labels, alpha, difference)
End Sub

Sub Ttestm(inprng1 As Variant, inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant)
    xTtestm = Application.Run(GetMacroRegId("fnTtestEq"), inprng1, inprng2, outrng, labels, alpha, difference)
End Sub
 
Upvote 0
Tiếp!
PHP: 
Sub TtestmQ(Optional inprng1 As Variant, Optional inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant)
    xTtestmQ = Application.Run(GetMacroRegId("fnTtestEqQ"), inprng1, inprng2, outrng, labels, alpha, difference)
End Sub

Sub zTestm(inprng1 As Variant, inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant, Optional var1 As Variant, Optional var2 As Variant)
    xzTestm = Application.Run(GetMacroRegId("fnZtestM"), inprng1, inprng2, outrng, labels, alpha, difference, var1, var2)
End Sub

Sub zTestmQ(Optional inprng1 As Variant, Optional inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant, Optional difference As Variant, Optional var1 As Variant, Optional var2 As Variant)
    xzTestmQ = Application.Run(GetMacroRegId("fnZtestMQ"), inprng1, inprng2, outrng, labels, alpha, difference, var1, var2)
End Sub

Sub Random(Optional outrng As Variant, Optional variables As Variant, Optional points As Variant, Optional distribution As Variant, Optional seed As Variant, Optional randarg1 As Variant, Optional randarg2 As Variant, Optional randarg3 As Variant, Optional randarg4 As Variant, Optional randarg5 As Variant)
    xRandom = Application.Run(GetMacroRegId("fnRandom"), outrng, variables, points, distribution, seed, randarg1, randarg2, randarg3, randarg4, randarg5)
End Sub

Sub RandomQ(Optional outrng As Variant, Optional variables As Variant, Optional points As Variant, Optional distribution As Variant, Optional seed As Variant, Optional randarg1 As Variant, Optional randarg2 As Variant, Optional randarg3 As Variant, Optional randarg4 As Variant, Optional randarg5 As Variant)
    xRandomQ = Application.Run(GetMacroRegId("fnRandomQ"), outrng, variables, points, distribution, seed, randarg1, randarg2, randarg3, randarg4, randarg5)
End Sub

Sub RankPerc(inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant)
    xRankPerc = Application.Run(GetMacroRegId("fnRankPerc"), inprng, outrng, grouped, labels)
End Sub

Sub RankPercQ(Optional inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant)
    xRankPercQ = Application.Run(GetMacroRegId("fnRankPercQ"), inprng, outrng, grouped, labels)
End Sub

Sub Regress(inpyrng As Variant, Optional inpxrng As Variant, Optional constant As Variant, Optional labels As Variant, Optional confid As Variant, Optional soutrng As Variant, Optional residuals As Variant, Optional sresiduals As Variant, Optional rplots As Variant, Optional lplots As Variant, Optional routrng As Variant, Optional nplots As Variant, Optional poutrng As Variant)
    xRegress = Application.Run(GetMacroRegId("fnRegress"), inpyrng, inpxrng, constant, labels, confid, soutrng, residuals, sresiduals, rplots, lplots, routrng, nplots, poutrng)
End Sub

Sub RegressQ(Optional inpyrng As Variant, Optional inpxrng As Variant, Optional constant As Variant, Optional labels As Variant, Optional confid As Variant, Optional soutrng As Variant, Optional residuals As Variant, Optional sresiduals As Variant, Optional rplots As Variant, Optional lplots As Variant, Optional routrng As Variant, Optional nplots As Variant, Optional poutrng As Variant)
    xRegressQ = Application.Run(GetMacroRegId("fnRegressQ"), inpyrng, inpxrng, constant, labels, confid, soutrng, residuals, sresiduals, rplots, lplots, routrng, nplots, poutrng)
End Sub

Sub Sample(inprng As Variant, Optional outrng As Variant, Optional method As Variant, Optional rate As Variant, Optional labels As Variant)
    xSample = Application.Run(GetMacroRegId("fnSample"), inprng, outrng, method, rate, labels)
End Sub

Sub SampleQ(Optional inprng As Variant, Optional outrng As Variant, Optional method As Variant, Optional rate As Variant, Optional labels As Variant)
    xSampleQ = Application.Run(GetMacroRegId("fnSampleQ"), inprng, outrng, method, rate, labels)
End Sub
 
Upvote 0
Chân Tình mà nói có lẽ Thầy siwtom nên Remove cái file đính kèm hàng "ĐỘC" đó đi ạ!
Hihi! Đó là nỗi kinh hoàng của biết bao những người có Tâm Huyết cố gắng xây dựng và tìm cách bảo vệ những thứ có ích với mục đích tốt đẹp.
Đọc "bài đó" của Thầy chẳng ai mà chống đỡ được nữa ...@@!
 
Lần chỉnh sửa cuối:
Upvote 0
l< i m đã viết:
Mình không hiểu bạn nói gì và ám chỉ bài của ai trong chủ đề này cả.
Mặt khác Chân Tình mà nói có lẽ Thầy siwtom nên Remove cái file đính kèm hàng ĐỘC đó đi ạ!
Hihi!
Nhấp chuột vào đây để mở rộng...
Thực tế mà nói mình không chuyên sâu gì bên mảng excel nhưng những bài như thế này có dính dáng tớ 1 phần công việc mình làm. Tùy bạn hay người khác nghĩ gì với mình tất cả rồi cũng chỉ là phù du mà thôi!
 
Upvote 0
l< i m đã viết:
Mình không hiểu bạn nói gì và ám chỉ bài của ai trong chủ đề này cả.
Mặt khác Chân Tình mà nói có lẽ Thầy siwtom nên Remove cái file đính kèm hàng ĐỘC đó đi ạ!
Hihi!
Nhấp chuột vào đây để mở rộng...

Đồng ý với bạn về câu tô đậm! ĐỘC ở đây tôi nghĩ là ĐỘC ĐÁO, nhưng nó có tính chất "xâm hại" đến code người khác nếu ai đó có ý phá hoại! Tôi cũng nghĩ Anh siwtom nên remove file đó đi thì hơn.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Đồng ý với bạn về câu tô đậm! ĐỘC ở đây tôi nghĩ là ĐỘC ĐÁO, nhưng nó có tính chất "xâm hại" đến code người khác nếu ai đó có ý phá hoại! Tôi cũng nghĩ Anh siwtom nên remove file đó đi thì hơn.
Nhấp chuột vào đây để mở rộng...

Hix! Em xem cũng chẳng hiểu gì cả những đọc thấy mấy bài của các Thầy nói lên sự bất ngờ qua bài viết của Thầy siwtom và nỗi lo sợ của mọi người đã cố công tạo nên nhưng thứ có ích mà bị kẻ xấu phá hoại. Tốt nhất nếu bỏ được thì bỏ đi Thầy à cho lành.
Đó cũng kiểu như là "Vi phạm bản quyền" hay còn gọi là xâm phạm trí tuệ...
Phạt 500.000.000 đồng đến 1.000.000.000 đòng nhưu chơi ý.... =)).
 
Upvote 0
quanghai1969 đã viết:
Mình thì chả thấy gì ghê gớm đến nỗi như 1 vài bạn đề nghị. Kiến thức thì phải có tính kế thừa. Nếu ai cũng giấu kín hết thì diễn đàn này sẽ đi về đâu.
Nhấp chuột vào đây để mở rộng...
Thầy ơi Người Kế thừa luôn chỉ có một, Nhưng người lăm le để được thừa kế thì nhiều gấp bội và họ sẽ tìm đủ mọi cách bắt luận xấu hay đẹp hay là trời sập đi chăng nữa họ cũng chẳng sợ, Kết cục Những người muốn kế thừa này cũng chẳng Kế thừa được.
cũng phải do Duyên số nữa đó... -\\/.

A!Hình như cả cái file của Thầy nữa thì phải ...hihihi....
Thầy là người "Châm Ngòi" phạt cũng như Thầy siwtom (1 tỷ đấy)! :D
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Mình thì chả thấy gì ghê gớm đến nỗi như 1 vài bạn đề nghị. Kiến thức thì phải có tính kế thừa. Nếu ai cũng giấu kín hết thì diễn đàn này sẽ đi về đâu.
Nhấp chuột vào đây để mở rộng...

Đúng là kiến thức thì được dạy, được học có trường lớp, còn không thì cũng nên ít phổ biến những vấn đề "nhạy cảm" đi. Giống như cô gái chưa chồng vậy, ai nhìn trộm lúc cô ấy tắm là bị "độp" liền, tuy nhiên sẳn sàng cho người yêu mình ôm hôn, âu yếm. Nếu ai đó "cho", "tặng" "biếu" một cái kính có thể nhìn xuyên quần áo cô ấy và tất cả phụ nữ trên đời này, thì quả là hết sức ẹc ẹc ...

Thường người ta nói "khóa kẻ ngay", nhưng "con ong cũng bay qua, con kiến cũng lọt vào" quá dễ dàng thì "tội lắm thay".

Lúc đầu tôi cũng có nghĩ không vấn đề gì, nhưng giờ thấy nó quá độc đáo làm mình cảm thấy giật cả mình!
 
Upvote 0
Nói như mọi người thì chẳng có diễn đàn nào có thể tồn tại lâu dài. Chúng ta biết chia sẽ rồi từ đó phát huy thôi. Nếu xét trên 1 quan điểm nào đó thì thật sự cái gì cũng sai cả và dĩ nhiên chẳng có cái gì đúng. Cía ta cần tìm ở đây là ứng dụng của nó là cấu trúc chuỗi của nó. Nhiều người sẽ cho rằng khi viết ra 1 đoạn mã nào đó hay chia sẽ 1 đoạn mã "không hay" thì sẽ tạo ra mặt trái của nó nhưng cái gì cũng có 2 mặt thôi. Chia sẽ không có nghĩa là giúp người khác phá hoại hay đánh cắp bất kỳ cái gì mà cái ở đây là tìm ra cách để ngăn chặn nó. Tôi rất ủng hộ ý kiến của mấy bạn nhưng có lẽ các bạn đang suy nghĩ vượt qua giới hạn của đoạn code viết ở trên rồi. Thân
 
Upvote 0
Mình nói ngoài lề tí nha: Sau khi dùng code của siwtom và unlock toàn bộ các Add-Ins của Microsoft... mọi người đã nhìn thấy code rồi, vậy có "chôm" được gì của bác Bill không (tức là học được gì ấy) hay chỉ là "nhìn" rồi... tối thui, chẳng biết ông Bill viết code quỷ gì cả?
Ẹc... Ẹc...
 
Upvote 0

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
l< i m đã viết:
Code dưới này là thế nào vậy ta?
Tự đặt pass VBA khi mở file hay là tự đặt pass vba khi đóng file thế nhỉ?
có thể như vậy được sao? híc!
Nhấp chuột vào đây để mở rộng...

Kim nói mình mới để ý!
Xin hỏi các chuyên gia GPE có code có thể tự động khóa pass vba khi mở file hay khi đóng file không nhỉ?
 
Upvote 0
Xin hỏi các chuyên gia có code nào xóa một sub trong module không?
 
Upvote 0
gakon_Office đã viết:
Xin hỏi các chuyên gia có code nào xóa một sub trong module không?
Nhấp chuột vào đây để mở rộng...

Mã: 
Sub DeleteProcedureCode(ByVal wb As Workbook, _
    ByVal DeleteFromModuleName As String, ByVal ProcedureName As String)
' cần có tham chiếu Microsoft Visual Basic Extensibility library
' xóa ProcedureName khỏi DeleteFromModuleName trong bảng tính wb
'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
Dim VBCM As CodeModule, ProcStartLine As Long, ProcLineCount As Long
    On Error Resume Next
'    module có phương thức cần xóa
    Set VBCM = wb.VBProject.VBComponents(DeleteFromModuleName).CodeModule
    If Not VBCM Is Nothing Then
'        tìm dòng đầu của phương thức (kể cả các dòng ghi chú ở trước Function, Sub ProcedureName)
'        nếu trả về 0 thì có nghĩa là phương thức không tồn tại
        ProcStartLine = VBCM.ProcStartLine(ProcedureName, vbext_pk_Proc)
        If ProcStartLine > 0 Then
'            tổng số dòng của phương thức
            ProcLineCount = VBCM.ProcCountLines(ProcedureName, vbext_pk_Proc)
'            xóa tất cả các dòng của phương thức
            VBCM.DeleteLines ProcStartLine, ProcLineCount
        End If
        Set VBCM = Nothing
    End If
    On Error GoTo 0
End Sub
 
Upvote 0
siwtom đã viết:
Mã: 
Sub DeleteProcedureCode(ByVal wb As Workbook, _
    ByVal DeleteFromModuleName As String, ByVal ProcedureName As String)
' cần có tham chiếu Microsoft Visual Basic Extensibility library
' xóa ProcedureName khỏi DeleteFromModuleName trong bảng tính wb
'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
Dim VBCM As CodeModule, ProcStartLine As Long, ProcLineCount As Long
    On Error Resume Next
'    module có phương thức cần xóa
    Set VBCM = wb.VBProject.VBComponents(DeleteFromModuleName).CodeModule
    If Not VBCM Is Nothing Then
'        tìm dòng đầu của phương thức (kể cả các dòng ghi chú ở trước Function, Sub ProcedureName)
'        nếu trả về 0 thì có nghĩa là phương thức không tồn tại
        ProcStartLine = VBCM.ProcStartLine(ProcedureName, vbext_pk_Proc)
        If ProcStartLine > 0 Then
'            tổng số dòng của phương thức
            ProcLineCount = VBCM.ProcCountLines(ProcedureName, vbext_pk_Proc)
'            xóa tất cả các dòng của phương thức
            VBCM.DeleteLines ProcStartLine, ProcLineCount
        End If
        Set VBCM = Nothing
    End If
    On Error GoTo 0
End Sub
Nhấp chuột vào đây để mở rộng...

Tuyệt quá có cả dịch nghĩa nữa! Tks Thầy!
***********************************
siwtom đã viết:
Mã: 
'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
Nhấp chuột vào đây để mở rộng...

Sao Thầy Chú thích ví dụ như vầy mà trong code không thấy nói đến các tên cụ thể đấy nhỉ:("vbe.xls"), "module2", "tinh toan"
 
Lần chỉnh sửa cuối:
Upvote 0
gakon_Office đã viết:
Tuyệt quá có cả dịch nghĩa nữa! Tks Thầy!
***********************************


Sao Thầy Chú thích ví dụ như vầy mà trong code không thấy nói đến các tên cụ thể đấy nhỉ:("vbe.xls"), "module2", "tinh toan"
Nhấp chuột vào đây để mở rộng...

Thật là rõ khổ. Thì bạn cứ copy code về chạy thử coi thế nào.
Khuyến mãi cho bạn thêm code này
Sub này cần phải có check trong mục Trust access to the VBA project object
Mã: 
Sub Xoa_Code()
Dim x As Integer
    On Error Resume Next
    With ActiveWorkbook.VBProject
        For x = .VBComponents.Count To 1 Step -1
            .VBComponents(x).CodeModule.DeleteLines 1, _
            .VBComponents(x).CodeModule.CountOfLines
            .VBComponents.Remove .VBComponents(x)
        Next x
    End With
End Sub
 
Upvote 0
gakon_Office đã viết:
Tuyệt quá có cả dịch nghĩa nữa! Tks Thầy!
***********************************


Sao Thầy Chú thích ví dụ như vầy mà trong code không thấy nói đến các tên cụ thể đấy nhỉ:("vbe.xls"), "module2", "tinh toan"
Nhấp chuột vào đây để mở rộng...

Code là tổng quát mà.
Bạn định xóa code của một hàm, phương thức nào đó? Rõ ràng nó phải có tên, đúng không? Thì nhập tên đó vào chỗ ProcedureName, tức thay cho "tinh toan" thì nhập vd. "MySecretFunction", với "MySecretFunction" là tên của hàm, phương thức cần xóa. Hơn thế nữa "MySecretFunction" nằm trong một module nào đó, đúng không? Giả dụ nằm trong "MySecretModule" thì thay vì "module2" thì nhập "MySecretModule" vào chỗ DeleteFromModuleName. Tất nhiên cái "MySecretModule" nó có trong workbook nào đó, đúng không? Thì nhập workbook đó vào chỗ wb thay cho Workbooks("vbe.xls"). Tức có thể nhập: Workbooks("MySecretBook.xls"), Workbooks(Book1.xls), Workbooks(1) v...v

Ví dụ là ví dụ về cách gọi. Khi bạn gọi phương thức thì bạn phải truyền thông số cụ thể cho lần gọi ấy chứ.
 
Upvote 0
siwtom đã viết:
Code là tổng quát mà.
Bạn định xóa code của một hàm, phương thức nào đó? Rõ ràng nó phải có tên, đúng không? Thì nhập tên đó vào chỗ ProcedureName, tức thay cho "tinh toan" thì nhập vd. "MySecretFunction", với "MySecretFunction" là tên của hàm, phương thức cần xóa. Hơn thế nữa "MySecretFunction" nằm trong một module nào đó, đúng không? Giả dụ nằm trong "MySecretModule" thì thay vì "module2" thì nhập "MySecretModule" vào chỗ DeleteFromModuleName. Tất nhiên cái "MySecretModule" nó có trong workbook nào đó, đúng không? Thì nhập workbook đó vào chỗ wb thay cho Workbooks("vbe.xls"). Tức có thể nhập: Workbooks("MySecretBook.xls"), Workbooks(Book1.xls), Workbooks(1) v...v

Ví dụ là ví dụ về cách gọi. Khi bạn gọi phương thức thì bạn phải truyền thông số cụ thể cho lần gọi ấy chứ.
Nhấp chuột vào đây để mở rộng...

Có điều chắc chắn là ta không thể nhớ chính xác tên đối tượng cần xóa. Vậy cần thêm 1 thủ tục để lấy tên các đối tượng ra ngoài bảng tính, khi muốn xóa đối tượng nào ta chọn nó rồi xóa bằng sự kiện phải chuột hoặc đúp chuột. Không biết ý tưởng đó có làm được không (tôi thì chịu)
 
Upvote 0
TrungChinhs đã viết:
Có điều chắc chắn là ta không thể nhớ chính xác tên đối tượng cần xóa. Vậy cần thêm 1 thủ tục để lấy tên các đối tượng ra ngoài bảng tính, khi muốn xóa đối tượng nào ta chọn nó rồi xóa bằng sự kiện phải chuột hoặc đúp chuột. Không biết ý tưởng đó có làm được không (tôi thì chịu)
Nhấp chuột vào đây để mở rộng...
Đương nhiên được chứ anh
Ví dụ code lấy các Procedures trong 1 Module
PHP: 
Function ListProcedures(ByVal ModuleName As String)
  Dim LineNum As Long, NumLines As Long, i As Long, Arr(), ProcName As String
  With ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    LineNum = .CountOfDeclarationLines + 1
    Do Until LineNum >= .CountOfLines
      ProcName = .ProcOfLine(LineNum, 0)
      ReDim Preserve Arr(i)
      Arr(i) = ProcName: i = i + 1
      LineNum = .ProcStartLine(ProcName, 0) + _
     .ProcCountLines(ProcName, 0) + 1
    Loop
  End With
  ListProcedures = Arr
End Function
Áp dụng =ListProcedures("Module1") ---> Sẽ lấy tên các Procedures trong Module1
 
Upvote 0
ndu96081631 đã viết:
Đương nhiên được chứ anh
Ví dụ code lấy các Procedures trong 1 Module
PHP: 
Function ListProcedures(ByVal ModuleName As String)
  Dim LineNum As Long, NumLines As Long, i As Long, Arr(), ProcName As String
  With ActiveWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    LineNum = .CountOfDeclarationLines + 1
    Do Until LineNum >= .CountOfLines
      ProcName = .ProcOfLine(LineNum, 0)
      ReDim Preserve Arr(i)
      Arr(i) = ProcName: i = i + 1
      LineNum = .ProcStartLine(ProcName, 0) + _
     .ProcCountLines(ProcName, 0) + 1
    Loop
  End With
  ListProcedures = Arr
End Function
Áp dụng =ListProcedures("Module1") ---> Sẽ lấy tên các Procedures trong Module1
Nhấp chuột vào đây để mở rộng...

Ndu cho file ví dụ xem áp dụng như thế nào. Mình vào bảng tính (có 2 Module 1 chứa code này, 1 chứa code khác) và nhập công thức =ListProcedures("Module1") đã thử với tên Module1 và Module2 nhưng kết quả vẫn là #VALUE!
 
Lần chỉnh sửa cuối:
Upvote 0
TrungChinhs đã viết:
Ndu cho file ví dụ xem áp dụng như thế nào. Mình vào bảng tính (có 2 Module 1 chứa code này, 1 chứa code khác) và nhập công thức =ListProcedures("Module1") đã thử với tên Module1 và Module2 nhưng kết quả vẫn là #VALUE!
Nhấp chuột vào đây để mở rộng...

Anh xem file dưới đây nhé
 

File đính kèm

Upvote 0
TrungChinhs đã viết:
Ndu cho file ví dụ xem áp dụng như thế nào. Mình vào bảng tính (có 2 Module 1 chứa code này, 1 chứa code khác) và nhập công thức =ListProcedures("Module1") đã thử với tên Module1 và Module2 nhưng kết quả vẫn là #VALUE!
Nhấp chuột vào đây để mở rộng...
Có thể lỗi xảy ra tại Trusted Center không anh? Phải check vào đó nó mới cho chạy code đấy!
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Có thể lỗi xảy ra tại Trusted Center không anh? Phải check vào đó nó mới cho chạy code đấy!
Nhấp chuột vào đây để mở rộng...

@ Nghĩa: đúng là tại Trusted.

ndu96081631 đã viết:
Anh xem file dưới đây nhé
Nhấp chuột vào đây để mở rộng...

@ Ndu: Hàm ListProcedures("Module1") thì được rồi nhưng mình muốn danh sách này được liệt kê ra bảng tính mình thử code dưới thì được nhưng không biết trong Module1 có bao nhiêu Macro để thay vào cái chỗ số 5 ?

Mã: 
Sub LisModule()
  [d2].Resize([B][COLOR=#ff0000]5[/COLOR][/B]) = WorksheetFunction.Transpose(ListProcedures("Module1"))
End Sub

Còn vấn đề nữa là nhờ bạn giúp tiếp hàm lấy các Module của File ra ngoài bảng tính.
 
Lần chỉnh sửa cuối:
Upvote 0
TrungChinhs đã viết:
@ Nghĩa: đúng là tại Trusted.



@ Ndu: Hàm ListProcedures("Module1") thì được rồi nhưng mình muốn danh sách này được liệt kê ra bảng tính mình thử code dưới thì được nhưng không biết trong Module1 có bao nhiêu Macro để thay vào cái chỗ số 5 ?

Mã: 
Sub LisModule()
  [d2].Resize([B][COLOR=#ff0000]5[/COLOR][/B]) = WorksheetFunction.Transpose(ListProcedures("Module1"))
End Sub

Còn vấn đề nữa là nhờ bạn giúp tiếp hàm lấy các Module của File ra ngoài bảng tính.
Nhấp chuột vào đây để mở rộng...
Thì anh làm vầy
Mã: 
Sub LisModule()
    Dim Arr
    Arr = ListProcedures("Module1")
    [d2].Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(ListProcedures("Module1"))
End Sub
Ubound(Arr) chính là cái anh cần
--------------------
Còn vụ lấy listModule, em nghĩ chắc là vầy:
PHP: 
Function ListModule()
  Dim mod_ As VBComponent
  Dim n As Long
  Dim Arr()
  For Each mod_ In ActiveWorkbook.VBProject.VBComponents
    If mod_.Type = 1 Then
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = mod_.Name
    End If
  Next
  If n Then ListModule = Arr
End Function
-----------------
Oh mà xem lại thì thấy mấy bài cuối chẳng ăn nhậu gì đến vụ DÙNG CODE VBA ĐỂ XÓA VBA cả. Anh TrungChinhs có thấy vậy không?
Ẹc... Ẹc... lộn tiệm dễ bị mod xóa bài quá
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Thì anh làm vầy
Mã: 
Sub LisModule()
    Dim Arr
    Arr = ListProcedures("Module1")
    [d2].Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(ListProcedures("Module1"))
End Sub
Ubound(Arr) chính là cái anh cần
--------------------
Còn vụ lấy listModule, em nghĩ chắc là vầy:
PHP: 
Function ListModule()
  Dim mod_ As VBComponent
  Dim n As Long
  Dim Arr()
  For Each mod_ In ActiveWorkbook.VBProject.VBComponents
    If mod_.Type = 1 Then
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = mod_.Name
    End If
  Next
  If n Then ListModule = Arr
End Function
-----------------
Oh mà xem lại thì thấy mấy bài cuối chẳng ăn nhậu gì đến vụ DÙNG CODE VBA ĐỂ XÓA VBA cả. Anh TrungChinhs có thấy vậy không?
Ẹc... Ẹc... lộn tiệm dễ bị mod xóa bài quá
Nhấp chuột vào đây để mở rộng...

Ấy... ấy... sao lại không ? Tại #123 tôi đã nêu rõ mục đích rồi mà. Tôi đang muốn lấy các Module và các Macro ra ngoài bảng tính sau đó dùng code của Siwtom tại # 119 để xóa. Mấy bài vừa rồi sẽ giúp cho việc thay tên đối tượng cần xóa trong Code của Siwtom bằng Selection.value.

Nếu có thời gian thì Ndu tiếp tục xem nào. Tôi sẽ thử tiếp, chỉ hiềm một nỗi là tôi không hiểu lắm các câu lệnh nên chỉ thực hiện máy móc theo kiểu thay thế IC thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
Hic đọc lại bài 119 thì ra là code xóa dòng trong Macro chứ không phải là code xóa Module hoặc xóa Macro nên Botay.com luôn.
Từ 2 bài của Ndu tôi mới làm được đến đây (xem file đính kèm). Bạn nào biết, viết giúp mình code Delete Macro và Remove Module. Thanks !
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
TrungChinhs đã viết:
Hic đọc lại bài 119 thì ra là code xóa dòng trong Macro chứ không phải là code xóa Module hoặc xóa Macro nên Botay.com luôn.
Từ 2 bài của Ndu tôi mới làm được đến đây (xem file đính kèm). Bạn nào biết, viết giúp mình code Delete Macro và Remove Module. Thanks !
Nhấp chuột vào đây để mở rộng...

Em chưa thử nên không biết.
Nhưng sắp tới Em cũng phải cần đến vấn đề này.
Nhưng ý Em hỏi là code xóa nguyên 1 tên "Sub" nào đó trong nhiều "Sub"
hoặc là xóa 1 module trong nhiều module mà....(trong 1 woorkbook).
Chứ không phải là xóa toàn bộ vba trong cửa sổ hay là xóa 1 dòng code nào trong 1 sub như anh nói.
 
Upvote 0
TrungChinhs đã viết:
Hic đọc lại bài 119 thì ra là code xóa dòng trong Macro chứ không phải là code xóa Module hoặc xóa Macro nên Botay.com luôn.
Từ 2 bài của Ndu tôi mới làm được đến đây (xem file đính kèm). Bạn nào biết, viết giúp mình code Delete Macro và Remove Module. Thanks !
Nhấp chuột vào đây để mở rộng...


Thì lỗi của bạn thôi. Lần sau đọc cho kỹ nhé.
Mà "xóa dòng" là không chính xác (xóa vài dòng trong SUB, trong MODULE? - làm gì có chuyện đó). Code xóa toàn bộ code của 1 hàm, phương thức có tên cho trước trong module có tên cho trước trong book cho trước.
Tôi thường đọc kỹ bài của người khác.
Code không xóa Module mà chỉ xóa hàm trong Module vì người hỏi viết: "Xin hỏi các chuyên gia có code nào xóa một sub trong module không"

-----------------------
Bạn viết code buồn cười thật. Sao bạn cứ gọi một code 2 lần kiểu như:
Mã: 
Arr = ListProcedures(Selection)
Selection(1, 2).Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(ListProcedures(Selection))
Bạn gọi 1 lần là được:
Mã: 
Arr = ListProcedures(Selection)
Selection(1, 2).Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(Arr)
------------

Để bạn làm được các việc đã nêu thì tôi cho bạn những code dưới đây. Chú ý:
1. DeleteProcedureCode không chỉ xóa code của hàm và sub trong Module mà cả code trong UserForm, Sheet1, 2, 3, ThisWorkBook (với CompName = "UserForm1", "Sheet1", "ThisWorkBook")

2. Tôi viết các hàm liệt kê đòi hỏi thông số WorkBook vì tôi muốn viết hàm tổng quát thao tác trên WorkBook bất kỳ (khi có nhiều WorkBook mở cùng lúc) chứ không chỉ trên ActiveWorkBook.
Nếu bạn chỉ cần thao tác trên ActiveWorkBook thôi thì truyền ActiveWorkBook vào thông số.

Mã: 
' [COLOR=#ff0000]liệt kê các hàm, sub có trong CompName (Sheet, ThisWorkBook, UserForm, Module)[/COLOR]
Function ListFunctions(ByVal book As Workbook, ByVal CompName As String)
'   Microsoft Visual Basic for Applications Extensibility
' Trả về danh sách hàm có trong CompName
Dim currLine As Long, k As Long, name As String, Arr()
    With book.VBProject.VBComponents(CompName).CodeModule
        currLine = .CountOfDeclarationLines + 1
        Do Until currLine >= .CountOfLines
            ReDim Preserve Arr(0 To k)
            name = .ProcOfLine(currLine, vbext_pk_Proc)
            Arr(k) = name
            currLine = currLine + .ProcCountLines(name, vbext_pk_Proc)
            k = k + 1
        Loop
    End With
    ListFunctions = Arr
End Function

'[COLOR=#ff0000] liệt kê các component (sheet, thisworkbook, userform, module, class module) có trong workbook[/COLOR]
Function ListComponents(ByVal book As Workbook)
'   tham chieu: Microsoft Visual Basic for Applications Extensibility
Dim VBComp As VBIDE.VBComponent, Arr(), k As Long
    For Each VBComp In book.VBProject.VBComponents
        ReDim Preserve Arr(0 To k)
        Arr(k) = VBComp.name
        k = k + 1
    Next VBComp
    ListComponents = Arr
End Function

'  [COLOR=#ff0000]xóa Module, Form, Class Module khỏi book[/COLOR]
Sub DeleteVBComponent(ByVal book As Workbook, ByVal CompName As String)
' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
' xóa vbcomponent có tên là CompName khỏi bảng tính wb
'    vbcomponent là Module, Class Module, Form
'    vd. DeleteVBComponent Workbooks("vbe.xls"), "class1"
'    DeleteVBComponent Workbooks("vbe.xls"), "module3"
'    DeleteVBComponent Workbooks("vbe.xls"), "myForm"
Dim VBCp As VBComponents
    Application.DisplayAlerts = False
    On Error Resume Next
    Set VBCp = book.VBProject.VBComponents
    If Not VBCp Is Nothing Then VBCp.Remove VBCp(CompName)
    Set VBCp = Nothing
    On Error GoTo 0
    Application.DisplayAlerts = True
End Sub

' [COLOR=#ff0000]xóa nội dung của Module nhưng vẫn giữ Module[/COLOR]
Sub DeleteModuleContent(ByVal book As Workbook, ByVal CompName As String)
'   cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
'   xóa nội dung (không xóa CompName) của module có tên là CompName trong bảng tính book
'    vd. DeleteModuleContent Workbooks("vbe.xls"), "module3"
    On Error Resume Next
    With book.VBProject.VBComponents(CompName).CodeModule
        .DeleteLines 1, .CountOfLines
    End With
    On Error GoTo 0
End Sub

' [COLOR=#ff0000]xóa code của hàm trong Module, UserForm, Sheet1, 2, 3, ThisWorkBook[/COLOR]
Sub DeleteProcedureCode(ByVal book As Workbook, _
    ByVal CompName As String, ByVal ProcedureName As String)
' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
' xóa ProcedureName khỏi CompName trong bảng tính book
'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
Dim VBCM As CodeModule, ProcStartLine As Long, ProcLineCount As Long
    On Error Resume Next
'    module có phương thức cần xóa
    Set VBCM = book.VBProject.VBComponents(CompName).CodeModule
    If Not VBCM Is Nothing Then
'        tìm dòng đầu của phương thức (kể cả các dòng ghi chú ở trước Function, Sub ProcedureName)
'        nếu trả về 0 thì có nghĩa là phương thức không tồn tại
        ProcStartLine = VBCM.ProcStartLine(ProcedureName, vbext_pk_Proc)
        If ProcStartLine > 0 Then
'            tổng số dòng của phương thức
            ProcLineCount = VBCM.ProcCountLines(ProcedureName, vbext_pk_Proc)
'            xóa tất cả các dòng của phương thức
            VBCM.DeleteLines ProcStartLine, ProcLineCount
        End If
        Set VBCM = Nothing
    End If
    On Error GoTo 0
End Sub

À, tôi là siwtom chứ không phải là Wistom
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn Thầy Siwtom rất nhiều về những bài viết trong Topic này.
Xin lỗi thầy về vụ gõ nhầm tên, em đã sửa lại.
Còn về cách viết, đối với những vấn đề mới lạ nhiều khi em cứ bị ngô nghê như vậy mà không nhận ra.
 
Lần chỉnh sửa cuối:
Upvote 0
TrungChinhs đã viết:
Cảm ơn Thầy Siwtom rất nhiều về những bài viết trong Topic này.
Xin lỗi thầy về vụ gõ nhầm tên, em đã sửa lại.
Còn về cách viết, đối với những vấn đề mới lạ nhiều khi em cứ bị ngô nghê như vậy mà không nhận ra.
Nhấp chuột vào đây để mở rộng...

Về yêu cầu của bạn là liệt kê và xóa các Function và Sub (macro) thì tôi đã gửi code.
Nhưng tôi muốn sửa 2 code để có thể liệt kê và xóa cả các property procedures (các property procedures Get, Let, Set trong class module)
Dưới đây tôi gửi lại code của Sub / Function. Những chỗ mầu đỏ là được thêm vào, chỗ mầu xanh là sửa (trước đó là vbext_pk_Proc, bây giờ là ProcKind)
Bây giờ thì tôi tin là code thao tác cho Sheet, ThisWorkbook, UserForm, Module và Class Module, tức "trọn gói".

Mã: 
Sub DeleteProcedureCode(ByVal wb As Workbook, _
    ByVal CompName As String, ByVal ProcedureName As String)
' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
' xóa ProcedureName khỏi CompName trong bảng tính wb
'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
Dim VBCM As CodeModule, ProcStartLine As Long, ProcLineCount As Long, [COLOR=#ff0000]ProcKind As Long[/COLOR]
'    module có phương thức cần xóa
    Set VBCM = wb.VBProject.VBComponents(CompName).CodeModule
    If Not VBCM Is Nothing Then
        [COLOR=#ff0000]On Error GoTo errHandler[/COLOR]
'        tìm dòng đầu của phương thức (kể cả các dòng ghi chú ở trước Function, Sub ProcedureName)
'        nếu trả về 0 thì có nghĩa là phương thức không tồn tại
        ProcStartLine = VBCM.ProcStartLine(ProcedureName, [COLOR=#0000ff]ProcKind[/COLOR])
        If ProcStartLine > 0 Then
'            tổng số dòng của phương thức
            ProcLineCount = VBCM.ProcCountLines(ProcedureName,[COLOR=#0000ff] ProcKind[/COLOR])
'            xóa tất cả các dòng của phương thức
            VBCM.DeleteLines ProcStartLine, ProcLineCount
        End If
        Set VBCM = Nothing
    End If
    Exit Sub
[COLOR=#ff0000]errHandler:
    If Err.Number = 35 And ProcKind < 3 Then
        ProcKind = ProcKind + 1
        Resume
    End If
[/COLOR]End Sub

Function ListFunctions(ByVal wb As Workbook, ByVal CompName As String)
'   Microsoft Visual Basic for Applications Extensibility
' Trả về danh sách hàm có trong module
Dim currLine As Long, k As Long, name As String, Arr(), size As Long, [COLOR=#ff0000]ProcKind As Long[/COLOR]
    With wb.VBProject.VBComponents(CompName).CodeModule
        currLine = .CountOfDeclarationLines + 1
        [COLOR=#ff0000]On Error GoTo errHandler[/COLOR]
        Do Until currLine >= .CountOfLines
            ReDim Preserve Arr(0 To k)
            name = .ProcOfLine(currLine, [COLOR=#0000ff]ProcKind[/COLOR])
            Arr(k) = name
            currLine = currLine + .ProcCountLines(name, [COLOR=#0000ff]ProcKind[/COLOR])
            k = k + 1
        Loop
    End With
    ListFunctions = Arr
    Exit Function
[COLOR=#ff0000]errHandler:
    If Err.Number = 35 And ProcKind < 3 Then
        ProcKind = ProcKind + 1
        Resume
    End If
[/COLOR]End Function
 
Upvote 0
quanghai1969 đã viết:
Cần gì phải đau khổ đến thế chứ, muốn xây thì khó chứ đập ra thì nhanh lắm

PHP: 
Sub Xoa_Modules()
Dim x
    On Error Resume Next
    With ActiveWorkbook.VBProject
        For x = .VBComponents.Count To 1 Step -1
            .VBComponents.Remove .VBComponents(x)
        Next x
    End With
End Sub

Còn việc Saveas thì có thể dùng thêm dòng lệnh Application.displayalerts=False để lưu đè lên file gốc rồi mà, đâu cần phải xoá nữa
Nếu bạn biết viết code rồi thì cái này đơn giản mà
Nhấp chuột vào đây để mở rộng...

Code này phù hợp với em vì em chỉ xóa VBA trong modules. Như vậy Code trên em sẽ cho vào một sheet nào đó là bảo toàn "tính mạng" anh quanghai1969 nhỉ :)

Vậy xóa xong rồi em muốn insert lại các modules (mục đích xóa bỏ cái cũ để update cái mới) thì em làm như nào (modules có từ 2 cái trở lên)
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Phát hiện thêm 1 chuyện nữa: Sau khi gọi hết tất cả các Add-Ins của MS lên (đương nhiên mấy Add-Ins này đều có Pass). Sau đó chạy code của siwtom thì toàn bộ các Add-Ins đều "mở cửa" ---> Xem code thoải mái
Quá sốc!_)()(-
Nhấp chuột vào đây để mở rộng...
Anh có thể cho em biết nếu đoạn code sau khi sử dụng với office 64b thì nên sửa thế nào không ạ. :(
Mã: 
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Long, Source As Long, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
        ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long     
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
        ByVal lpProcName As String) As Long
Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
 
Upvote 0
siwtom đã viết:
Lại bị gọi lên bảng.
ndu nói thế là không đúng. Tự tôi không nghĩ ra được code vì cái khoản này nó thuộc "lập trình cao
cấp". Nhưng khi lập trình trong Delphi thì tôi cũng gặp và hiểu được cơ cấu của nó là như thế nào.
Và khi tôi đọc qua code có trong Excel.xls của quanghai gửi thì 99,99% tôi chắc chắn là nó sử dụng
"kỹ thuật lập trình cao cấp" mà tôi sẽ giải thích dưới đây.
Nếu các bạn có chút thời gian thì tôi sẽ giải thích nôm na nó như thế nào. Nôm na vì tôi sẽ dùng
ngôn ngữ thường ngày để giải thích chứ dùng ngôn ngữ "chuyên ngành" thì e rằng người không lập
trình khó hiểu.
---------------
1. Trước tiên nói về cái cửa sổ mà Excel bắt ta phải nhập mật khẩu. Như trong code Excel.xls "đã
chỉ rõ" thì Excel gọi hàm system là DialogBoxParam để hiển thị cửa sổ hộp thoại. Tất nhiên Excel
phải tạo một cửa sổ hộp thoại (template) đặt trong resource và truyền thông tin về nó cho hàm
DialogBoxParam. Hàm DialogBoxParam sẽ tạo (trên cơ sở template) hộp thoại và hiển thị. Excel
cũng phải lập một procedure cho cửa sổ (DialogProc) mà DialogBoxParam tạo và hiển thị. Để làm
gì? Để nhận các thông điệp. Vd. Windows sẽ gửi thông điệp WM_INITDIALOG khi cửa sổ được
khởi tạo. Ta có thể khi nhận được thông điệp này (tức ở thời điểm "chào buổi sáng") làm một số
việc thiết lập ban đầu, tạo thêm controls - nó giống như ta thiết lập một số cái trong
UserForm_Initialize ấy mà. Windows cũng gửi thông điệp khi user nhấn nút nào đấy (chỉ rõ là nút
nào) để DialogProc xử lý. Vd. nếu nút nhấn là Cancel thì code DialogProc "dọn đồ ra về" còn nếu là
OK thì kiểm tra dữ liệu nhập rồi cũng "dọn đồ" - tức hủy hộp thoại. Tất nhiên Windows còn gửi nhiều
thông điệp khác, nếu DialogProc "quan tâm" thì xử lý.
Khi người lập trình muốn hủy hộp thoại (user chọn Cancel?, chọn OK? ...) thì code của DialogProc
phải gọi EndDialog để system biết và hủy hộp thoại. Khi gọi EndDialog thì phải truyền kết quả trả
về dưới dạng thông số của EndDialog. Hàm DialogBoxParam cũng sẽ trả vể kết quả này. Từ cơ
cấu như trên thì người lập trình có thể viết code đại loại như sau:
a - Gọi hàm DialogBoxParam để tạo cửa sổ nhập mật khẩu - template sẽ gồm textbox (class "Edit"
của Windows) để nhập mật khẩu, nút OK và Cancel. Trong DialogProc nếu nhận được thông điệp
do Windows gửi nói là user nhấn Cancel thì gọi EndDialog(hDialog, 0) - hDialog là "handle to
dialog box", 0 là giá trị trả về, cũng là giá trị mà hàm DialogBoxParam trả về. Nếu thông điệp nói là
user nhấn OK thì: kiểm tra mật khẩu có đúng không, nếu đúng thì EndDialod(hDialog, 1) còn nếu sai
thì EndDialog(hDialog, 0)
Cũng cần nói rõ là khi gọi hàm DialogBoxParam và cửa sổ hiển thị thì hàm DialogBoxParam chỉ
trở về, và mọi code sau dòng gọi hàm DialogBoxParam được thực hiện, khi mà hộp thoại được
đóng (do code trong DialogProc gọi EndDialog). Trong suốt thời gian hộp thoại hiển thị thì chỉ có
code trong DialogProc được thực hiện mà thôi (kiểu như ShowModal ấy mà - cho tới khi cửa sổ
được đóng thì mọi code sau ShowModal "phải chờ")
b - Ở dòng code sau dòng gọi hàm DialogBoxParam thì người lập trình kiểm tra giá trị trả về bởi
hàm DialogBoxParam. Nếu là 0 (tức user chọn Cancel hoặc chọn OK nhưng mật khẩu sai) thì:
Mã: 
MsgBox "Này ông tướng, phải nhập mật khẩu đúng mới được chiêm ngưỡng code đấy nhé"
Còn nếu là 1 (user chọn OK và nhập đúng mật khẩu) thì mở code cho user xem.
-----------------
Như trên đã thấy thì bình thường người lập trình sẽ làm trình tự như trên và Excel cũng làm như thế.
Bây giờ ta hình dung là ta viết code như sau:
Ta viết hàm DialogBoxParam "nhái" - vd. hàm MyDialogBoxParam, và đánh tráo nó với hàm
DialogBoxParam của system. Tất nhiên hàm "nhái" này phải có cấu trúc thông số y hệt hàm của
system. Lúc này nếu có "ai đó" gọi hàm DialogBoxParam thì Windows sẽ gọi hàm
MyDialogBoxParam. Hàm của ta nếu kiểm tra thấy template = 4070 thì chả hiển thị hộp thoại nào
cả mà hàm trả về luôn giá trị 1. Trong trường hợp ngược lại thì tráo lại thành hàm DialogBoxParam
của system và gọi nó - vì trong cùng thời điểm có thể những phần mềm khác trong system cũng gọi
hàm DialogBoxParam, ta phải trả lại "hiện trạng" cũ để các phần mềm đó hiển thị hộp thoại của
mình. Cách làm thế nào?
---------------
Tất cả các hàm của system đều nằm trong các thư viện động DLL. Mỗi thư viện như thế có nhiều
section, có header. Riêng về các function trong thư viện thì: Khi DLL được load vào RAM thì nó
nằm ở một chỗ nào đó, địa chỉ nào đó trong RAM. Lúc này mỗi function cũng nằm ở một địa chỉ
nào đó trong RAM. DLL là "dùng chung" cho mọi process, tức nếu A, B, C cùng "gọi" bla.dll thì
bla.dll sẽ được ánh xạ vào mỗi "không gian địa chỉ" của mỗi process A, B, C. "Địa chỉ" của mỗi
function có trong DLL sẽ được ghi trong RAM ở "đâu đó" trong phần header, mỗi function có 1
trường để ghi địa chỉ của nó. Ta xét vd. hàm DialogBoxParam. Giả sử "ở đấy ở đấy" có giá trị là
"123456789" thì bình thường khi process gọi hàm DialogBoxParam thì system sẽ tới "chỗ ấy chỗ
ấy" để đọc ra địa chỉ của hàm DialogBoxParam - sẽ đọc được "123456789". Lúc này sẽ có 1
bước nhẩy tới địa chỉ "123456789" và thực hiện code của DialogBoxParam vì code của
DialogBoxParam nằm ở địa chỉ ấy mà.
Bây giờ ta hãy tưởng tượng là ta viết hàm MyDialogBoxParam (hàm nhái) mà nó nằm ở địa chỉ
"abc...xyz" (đọc ra bằng AddressOf). Code sau đó nhẩy tới "chỗ ấy chỗ ấy" và ghi giá trị "abc...xyz"
đè lên "123456789". Từ lúc này mỗi khi process nào đó gọi DialogBoxParam thì system nhẩy tới
"chỗ ấy chỗ ấy" và đọc ra địa chỉ "abc...xyz" (chứ không phải "123456789" nữa) và nhẩy tới địa chỉ
"abc...xyz" để thực hiện code. Chỉ có điều ở "abc...xyz" là code của hàm nhái MyDialogBoxParam
chứ không phải của hàm DialogBoxParam.
Tất nhiên trước khi đánh tráo địa chỉ của hàm được ghi ở "đâu đó" (trong header của DLL) trong
RAM thì ta phải ghi nhớ nó để sau đó trả về hiện trạng cũ - lại tới "chỗ ấy chỗ ấy" và ghi vào
"123456789" đè lên "abc...xyz"
Những kỹ thuật: xin phép thao tác trong RAM ở vùng nào đó, ghi trong RAM, đánh tráo địa chỉ hàm
... là những kỹ thuật cao cấp. Người có trình độ trung bình cũng có thể thao tác trong RAM nhưng để
đánh tráo địa chỉ thì phải thông hiểu nhiều hơn mới biết cách làm - thay đổi những bai nào trong
RAM, ở đâu ...
----------------
Trở lại code của quanghai gửi nếu tôi không lầm thì hiện thời code "chưa làm gì cả". Vì khi hiển thị
FrmHookMain và nhấn nút "RemoveVBAPassword" thì code đánh tráo địa chỉ của hàm
DialogBoxParam (thay vì hướng tới DialogBoxParam thì hướng tới hàm nhái MyDialogBoxParam)
nhưng ta không click được vào VBAProject để xem code. Phải đóng FrmHookMain mới click vào
được. Nhưng khi đóng FrmHookMain thì địa chỉ cũ lại được trả lại (đánh tráo lại) trong
UserForm_Terminate nên lúc này có nhấn VBAProject thì hàm DialogBoxParam lại được thực hiện
chứ không phải hàm nhái nên ta lại thấy hộp thoại bắt nhập mật khẩu hiện ra.
Vậy trong tập tin đính kèm tôi làm như sau:
a - Trên Sheet có 2 nút: "Đánh tráo" và "Trả lại"
b - Trước tiên ta nhấn "Đánh tráo", code của nó là:
Mã: 
If Hook Then
        MsgBox "VBA Password is Removed!", vbInformation, "Excel Tool"
End If
Từ lúc này mọi cuộc gọi hàm DialogBoxParam thì thực chất là gọi hàm nhái MyDialogBoxParam
mà nó sẽ trả về 1, tức Excel sau đó kiểm tra thấy 1 được trả về thì tưởng rằng user nhập đúng mật
khẩu và nhấn OK - y như cái procedure của hộp thoại mà nó thiết kế trả về khi user nhập đúng mật
khẩu và nhấn OK.
c - Ta nhấn VBAProject để xem và copy code
d - Ta nhấn "Trả lại" để thực hiện code RecoverBytes. Nó sẽ trả lại (trong RAM) địa chỉ cũ của hàm
DialogBoxParam.
-----------------
Nói đến test thì tôi lại là vua lười.
Vậy ndu hãy test và thông báo kết quả thế nào
Nhấp chuột vào đây để mở rộng...
Xin hỏi anh và các anh chị trên diễn đàn!.
Tôi sử dụng file thì thấy code báo lỗi đoạn code sau: (Tôi sử dụng Win 10 và office 2013) mong anh chị giúp

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

V
  • Question Question
xác định xu hướng
Trả lời
3
Đọc
72
vuthienfx
V
Tuấn Bụng Bự
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (2 người xem)
Trả lời
1
Đọc
28
PhanTuHuong
PhanTuHuong
giaiphap
Lập trình C# tạo Add-ins cho excel. (4 người xem)
    • Thích
Trả lời
52
Đọc
7K
nguyendang95
N
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
383
Đọc
45K
nguyendang95
N
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản." (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
Y
Lấy dữ liệu từ sheet chi tiết sang sheet tổng hợp hàng dọc
Trả lời
6
Đọc
564
yoomi
Y
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
16
Đọc
381
Phan Thế Hiệp
Phan Thế Hiệp
N
Hàm tính chuỗi số trong 1 ô hoặc 1 dãy ô ra tổng kết quả.
Trả lời
2
Đọc
107
minhminh27
minhminh27
NguyenthiH
Mở file Excel có Pass Open
Trả lời
39
Đọc
3K
Hoàng Tuấn 868
H
M
Tách dữ liệu trong 1 file thành nhiều sheet theo số lượng dòng (1 người xem)
    • Ngạc nhiên
Trả lời
25
Đọc
3K
Hoàng Tuấn 868
H
T
Tìm số hóa đơn trong chuỗi
Trả lời
11
Đọc
438
thao nguyen01
T
T
  • Question Question
Nhờ ACE cao thủ hỗ trợ mình có một chương trình EXCEL về phân công lớp cho giáo viên
Trả lời
6
Đọc
337
DeTong
D
T
Nhờ các anh chị sửa dùm công thức ạ.
Trả lời
10
Đọc
224
trantrungvinh1989
T
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
24
Đọc
2K
phuongdaik98
P
Phan Thế Hiệp
Quy đổi từ Thu nhập sau thuế (TNCN) ra Thu nhập tính thuế (1 người xem)
    • Yêu thích
    • Thích
Trả lời
1
Đọc
366
Phan Thế Hiệp
Phan Thế Hiệp
V
Quên mật khẩu file excel (1 người xem)
Trả lời
25
Đọc
2K
YêuCN
Y
Nguyen Rem
  • Question Question
Lỗi "User-defined type not defined" khi khai báo biến
Trả lời
28
Đọc
2K
nguyendang95
N
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
311
vietvanyen
V
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
134
Hoàng Tuấn 868
H
Xem thêm…

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.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom