Có thể dùng vba để xóa vba đc không?

Chia sẻ bởi:hands

★★★★★

‹ #LabX – Addin khóa và mở khóa... Xóa một sub trong module ›

Quảng cáo

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 ạ?

Thế thì cho bạn cái "cần câu"

Sub Test()
  With ThisWorkbook.VBProject
    .VBComponents.Remove .VBComponents("Module1")
  End With
End Sub

"câu cá" thế nào là tùy bạn nhé
FileFormat:=51 <==> FileFormat:=xlOpenXMLWorkbook—> Cũng là thằng em XLSX

Bạn cứ vào cửa sổ VBE, gõ đâu đó cái này ThisWorkbook.SaveAs, bôi đen nội dung vừa gõ rồi nhấn F1, tại hàng mô tả về FileFormat, bạn sẽ nhìn thấy một danh mục XlFileFormat. Click vào đó là bạn có thể biết tất cả về mấy con số này thôi mà.
Còn câu lệnh xóa file thì chỉ là như vầy thôi mà: Kill "Đường dẫnTên file"
Tóm lại là bạn cần làm 2 việc:
1. SaveAs file gốc thành file .xlsx (file mới sẽ không còn code nữa).
2. Xóa file gốc đi bằng lệnh Kill.

À đấy! phải thế chứ! thiếu việc 2! =))

Cần gì phải đau khổ đến thế chứ, muốn xây thì khó chứ đập ra thì nhanh lắm

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à

Vấn đề là với mỗi loại file nó có phần mở rộng khác nhau mà anh. Chẳng hạn, file gốc là Test.xlsm, sau khi SaveAs thì nó thành Test.xlsx chứ nhỉ?!
Theo hướng làm ở trên thì em làm như vầy:
Sub Test()
Application.DisplayAlerts = False
ThisWorkbook.SaveAs "C:Test.xlsx", 51
Application.DisplayAlerts = True
Kill "C:Test.xlsm"
End Sub
Ồ! Ngon. :D.
Mà… Bác nói vậy chứ code em cũng biết viết gì đâu. Chỉ là biết mỗi cái copy và pase thêm 1 tý mô đi phê nữa… hehe!
Tks Bác!

Bạn có chắc chắn là "ngon" 100% không?
Tôi hiểu "xóa toàn bộ vba" của bạn là xóa toàn bộ code trong VBA. Tôi hiểu đúng?
Bạn nên hiểu là xóa component và xóa code là 2 "cô nàng" khác nhau. Code của quanghai là xóa component.
Trong VBE ở bên nửa trái bạn có component, bên nửa phải bạn có code. Nếu component bị xóa thì dĩ nhiên code của nó cũng "cuốn theo chiều gió". Thế nếu component không bị xóa thì sao? Theo lôgíc thì code vẫn còn trơ trẽn nằm tơ hơ.
Code của quanghai không xóa Sheet1, 2, 3, ThisWorkbook, vậy nếu chúng có hằng hà sa số code thì những code này vẫn còn.
Vậy nếu bạn muốn xóa class module, module, userform, …, code của Sheet1, 2, 3, …, ThisWorkbook thì
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
Code cũng hơi độc hại nên em tính cất lại chút ít. Em viết thế này

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

Đúng rồi! Cám ơn Bác nhé!
Em cũng đang thắc mắc vấn đề này từ lúc code của Thầy Ndu cơ.
Thật ra đến thời điểm này Em cũng chưa test 1 trường hợp nào trong bài này cả.
Nên có post nên sợ các Bác bảo lười.
VBA thì có rất nhiều trong sheet như Bác nói, This wordbook nữa.
module,UserForm,class v.v…
Tóm lại là xóa sạch…
Cái này E sẽ thử nó!

Theo tôi nghĩ, code dạng này, theo tác giả là không cho xem code nên mới xóa, thì OK, nhưng nếu người ta không để chế độ tự động chạy macro (macro setting) thì cũng chẳng có gì xảy ra.

Mặt khác, nếu ta giấu code, đặt password cho VBA cũng không là vấn đề. Nếu người muốn thấy code của mình, tức là người đó cũng hiểu biết và thậm chí hiểu biết rất rõ về VBA thì không xóa được với họ đâu, họ không cho chạy macro, rồi họ bẻ khóa (diễn đàn nói nhiều về việc này), thì code cũng sẽ lộ ra ngay trước khi code xóa VBA thực hiện!

Nên tôi nghĩ hướng dẫn thì ta cứ hướng dẫn, chẳng ngại ngùng gì! Người không biết chẳng ai thèm quan tâm đến code, người quá hiểu biết thì có xóa, giấu, cũng không được, chỉ có giấu người dỡ dỡ ương ương thôi.

www.giaiphapexcel.com/diendan/threads/c%C3%B3-th%E1%BB%83-d%C3%B9ng-vba-%C4%91%E1%BB%83-x%C3%B3a-vba-%C4%91c-kh%C3%B4ng.72632

Khóa học SprinGO phù hợp

Thiết kế Tổng đãi ngộ (Total Rewards) theo khung SHRM

Khóa học “Thiết kế Tổng phần thưởng (Total Reward) chuẩn khung SHRM” giúp bạn nắm vững toàn bộ hệ thống đãi ngộ theo chuẩn...

Xem khóa học

★★★★★ 5 ★ 1 👤 14 ▥ 0

‹ #LabX – Addin khóa và mở khóa mã... Xóa một sub trong module ›

Quảng cáo

Bạn nên đọc

Tổng hợp file Excel tính giá thành sản phẩm cho doanh nghiệp sản xuất, gia công, xây lắp

Hướng dẫn xử lý file Excel chậm

Công thức quy đổi lương NET sang GROSS

Cách tách chuỗi trong dấu ngoặc Excel bằng công thức và Flash Fill

14 Responses

hands says:

18/01/2023 at 2:39 pm

Thông thường pass VBA rất dễ mở hoặc phá, nhưng em có file này không thể phá pass được. Anh chị nào mở hoặc phá được pass của file này em thật sự phục sát đất. File này không có dữ liệu gì cả, chỉ có pass VBA bên trong thôi

Mở khóa trong vòng 3s

Quả là đáng nể thật, em mày mò mãi không cách nào phá được.

Hình như 3s này chỉ là cách nói cường điệu một chút thì phải. Tôi mở bằng hexeditor –> tìm 3 "chú" –> sửa lại –> ghi lại. Tổng cộng mất mười mấy s.
Hay là Tuấn có automata? Chuột phải –> chọn automata –> xong luôn?

Em cũng dùng Hexeditor nhưng làm quen tay rồi anh à:
– Ctrl + F
– Gõ CMG, Enter
– Bôi đen chổ cần xóa rồi bấm nút Delete và Save
Xong!
Ẹc… Ẹc… 3s hơi cường điệu nhưng sự thật là rất nhanh
Vấn đề Unprotect Password VBA tôi đã nghiên cứu từ rất lâu rồi mà dường như.. không có cách
Tham khảo các trang web nước ngoài, người ta cũng chỉ có thể dùng phương pháp SendKeys (kiểu như "dạy" cho máy tính cách ta làm bằng tay bằng cách bấm các tổ hợp phím nào đó)
Tuy nhiên, phương pháp dùng SendKeys đôi lúc không ổn định, khi được khi không nên tôi chưa giới thiệu
Nghe đồn rằng có cách dùng hàm API để truy đến các cửa sổ lập trình VBA gì gì đó nhưng tiếc là tôi lại không rành —> E rằng làm được món này chỉ có thể là siwtom —> Chở xem
——————————————

Trên mạng có file password.xla (chắc của một cao thủ nước ngoài), mình tìm nó không có CMG thì làm sao? Mình không muốn phá khóa để lấy code, chỉ muốn học cách khóa code như họ. Bạn có biết họ khóa kiểu gì không?

Lại bị gọi lên bảng.
ndu nói thế là không đúng. Tự tôi không nghĩ ra được code vì cái khoản này nó thuộc "lập trình cao
cấp". Nhưng khi lập trình trong Delphi thì tôi cũng gặp và hiểu được cơ cấu của nó là như thế nào.
Và khi tôi đọc qua code có trong Excel.xls của quanghai gửi thì 99,99% tôi chắc chắn là nó sử dụng
"kỹ thuật lập trình cao cấp" mà tôi sẽ giải thích dưới đây.
Nếu các bạn có chút thời gian thì tôi sẽ giải thích nôm na nó như thế nào. Nôm na vì tôi sẽ dùng
ngôn ngữ thường ngày để giải thích chứ dùng ngôn ngữ "chuyên ngành" thì e rằng người không lập
trình khó hiểu.
—————
1. Trước tiên nói về cái cửa sổ mà Excel bắt ta phải nhập mật khẩu. Như trong code Excel.xls "đã
chỉ rõ" thì Excel gọi hàm system là DialogBoxParam để hiển thị cửa sổ hộp thoại. Tất nhiên Excel
phải tạo một cửa sổ hộp thoại (template) đặt trong resource và truyền thông tin về nó cho hàm
DialogBoxParam. Hàm DialogBoxParam sẽ tạo (trên cơ sở template) hộp thoại và hiển thị. Excel
cũng phải lập một procedure cho cửa sổ (DialogProc) mà DialogBoxParam tạo và hiển thị. Để làm
gì? Để nhận các thông điệp. Vd. Windows sẽ gửi thông điệp WM_INITDIALOG khi cửa sổ được
khởi tạo. Ta có thể khi nhận được thông điệp này (tức ở thời điểm "chào buổi sáng") làm một số
việc thiết lập ban đầu, tạo thêm controls – nó giống như ta thiết lập một số cái trong
UserForm_Initialize ấy mà. Windows cũng gửi thông điệp khi user nhấn nút nào đấy (chỉ rõ là nút
nào) để DialogProc xử lý. Vd. nếu nút nhấn là Cancel thì code DialogProc "dọn đồ ra về" còn nếu là
OK thì kiểm tra dữ liệu nhập rồi cũng "dọn đồ" – tức hủy hộp thoại. Tất nhiên Windows còn gửi nhiều
thông điệp khác, nếu DialogProc "quan tâm" thì xử lý.
Khi người lập trình muốn hủy hộp thoại (user chọn Cancel?, chọn OK? …) thì code của DialogProc
phải gọi EndDialog để system biết và hủy hộp thoại. Khi gọi EndDialog thì phải truyền kết quả trả
về dưới dạng thông số của EndDialog. Hàm DialogBoxParam cũng sẽ trả vể kết quả này. Từ cơ
cấu như trên thì người lập trình có thể viết code đại loại như sau:
a – Gọi hàm DialogBoxParam để tạo cửa sổ nhập mật khẩu – template sẽ gồm textbox (class "Edit"
của Windows) để nhập mật khẩu, nút OK và Cancel. Trong DialogProc nếu nhận được thông điệp
do Windows gửi nói là user nhấn Cancel thì gọi EndDialog(hDialog, 0) – hDialog là "handle to
dialog box", 0 là giá trị trả về, cũng là giá trị mà hàm DialogBoxParam trả về. Nếu thông điệp nói là
user nhấn OK thì: kiểm tra mật khẩu có đúng không, nếu đúng thì EndDialod(hDialog, 1) còn nếu sai
thì EndDialog(hDialog, 0)
Cũng cần nói rõ là khi gọi hàm DialogBoxParam và cửa sổ hiển thị thì hàm DialogBoxParam chỉ
trở về, và mọi code sau dòng gọi hàm DialogBoxParam được thực hiện, khi mà hộp thoại được
đóng (do code trong DialogProc gọi EndDialog). Trong suốt thời gian hộp thoại hiển thị thì chỉ có
code trong DialogProc được thực hiện mà thôi (kiểu như ShowModal ấy mà – cho tới khi cửa sổ
được đóng thì mọi code sau ShowModal "phải chờ")
b – Ở dòng code sau dòng gọi hàm DialogBoxParam thì người lập trình kiểm tra giá trị trả về bởi
hàm DialogBoxParam. Nếu là 0 (tức user chọn Cancel hoặc chọn OK nhưng mật khẩu sai) thì:
```
MsgBox "Này ông tướng, phải nhập mật khẩu đúng mới được chiêm ngưỡng code đấy nhé"
```
Còn nếu là 1 (user chọn OK và nhập đúng mật khẩu) thì mở code cho user xem.
—————–
Như trên đã thấy thì bình thường người lập trình sẽ làm trình tự như trên và Excel cũng làm như thế.
Bây giờ ta hình dung là ta viết code như sau:
Ta viết hàm DialogBoxParam "nhái" – vd. hàm MyDialogBoxParam, và đánh tráo nó với hàm
DialogBoxParam của system. Tất nhiên hàm "nhái" này phải có cấu trúc thông số y hệt hàm của
system. Lúc này nếu có "ai đó" gọi hàm DialogBoxParam thì Windows sẽ gọi hàm
MyDialogBoxParam. Hàm của ta nếu kiểm tra thấy template = 4070 thì chả hiển thị hộp thoại nào
cả mà hàm trả về luôn giá trị 1. Trong trường hợp ngược lại thì tráo lại thành hàm DialogBoxParam
của system và gọi nó – vì trong cùng thời điểm có thể những phần mềm khác trong system cũng gọi
hàm DialogBoxParam, ta phải trả lại "hiện trạng" cũ để các phần mềm đó hiển thị hộp thoại của
mình. Cách làm thế nào?
—————
Tất cả các hàm của system đều nằm trong các thư viện động DLL. Mỗi thư viện như thế có nhiều
section, có header. Riêng về các function trong thư viện thì: Khi DLL được load vào RAM thì nó
nằm ở một chỗ nào đó, địa chỉ nào đó trong RAM. Lúc này mỗi function cũng nằm ở một địa chỉ
nào đó trong RAM. DLL là "dùng chung" cho mọi process, tức nếu A, B, C cùng "gọi" bla.dll thì
bla.dll sẽ được ánh xạ vào mỗi "không gian địa chỉ" của mỗi process A, B, C. "Địa chỉ" của mỗi
function có trong DLL sẽ được ghi trong RAM ở "đâu đó" trong phần header, mỗi function có 1
trường để ghi địa chỉ của nó. Ta xét vd. hàm DialogBoxParam. Giả sử "ở đấy ở đấy" có giá trị là
"123456789" thì bình thường khi process gọi hàm DialogBoxParam thì system sẽ tới "chỗ ấy chỗ
ấy" để đọc ra địa chỉ của hàm DialogBoxParam – sẽ đọc được "123456789". Lúc này sẽ có 1
bước nhẩy tới địa chỉ "123456789" và thực hiện code của DialogBoxParam vì code của
DialogBoxParam nằm ở địa chỉ ấy mà.
Bây giờ ta hãy tưởng tượng là ta viết hàm MyDialogBoxParam (hàm nhái) mà nó nằm ở địa chỉ
"abc…xyz" (đọc ra bằng AddressOf). Code sau đó nhẩy tới "chỗ ấy chỗ ấy" và ghi giá trị "abc…xyz"
đè lên "123456789". Từ lúc này mỗi khi process nào đó gọi DialogBoxParam thì system nhẩy tới
"chỗ ấy chỗ ấy" và đọc ra địa chỉ "abc…xyz" (chứ không phải "123456789" nữa) và nhẩy tới địa chỉ
"abc…xyz" để thực hiện code. Chỉ có điều ở "abc…xyz" là code của hàm nhái MyDialogBoxParam
chứ không phải của hàm DialogBoxParam.
Tất nhiên trước khi đánh tráo địa chỉ của hàm được ghi ở "đâu đó" (trong header của DLL) trong
RAM thì ta phải ghi nhớ nó để sau đó trả về hiện trạng cũ – lại tới "chỗ ấy chỗ ấy" và ghi vào
"123456789" đè lên "abc…xyz"
Những kỹ thuật: xin phép thao tác trong RAM ở vùng nào đó, ghi trong RAM, đánh tráo địa chỉ hàm
… là những kỹ thuật cao cấp. Người có trình độ trung bình cũng có thể thao tác trong RAM nhưng để
đánh tráo địa chỉ thì phải thông hiểu nhiều hơn mới biết cách làm – thay đổi những bai nào trong
RAM, ở đâu …
—————-
Trở lại code của quanghai gửi nếu tôi không lầm thì hiện thời code "chưa làm gì cả". Vì khi hiển thị
FrmHookMain và nhấn nút "RemoveVBAPassword" thì code đánh tráo địa chỉ của hàm
DialogBoxParam (thay vì hướng tới DialogBoxParam thì hướng tới hàm nhái MyDialogBoxParam)
nhưng ta không click được vào VBAProject để xem code. Phải đóng FrmHookMain mới click vào
được. Nhưng khi đóng FrmHookMain thì địa chỉ cũ lại được trả lại (đánh tráo lại) trong
UserForm_Terminate nên lúc này có nhấn VBAProject thì hàm DialogBoxParam lại được thực hiện
chứ không phải hàm nhái nên ta lại thấy hộp thoại bắt nhập mật khẩu hiện ra.
Vậy trong tập tin đính kèm tôi làm như sau:
a – Trên Sheet có 2 nút: "Đánh tráo" và "Trả lại"
b – Trước tiên ta nhấn "Đánh tráo", code của nó là:
```
If Hook Then
        MsgBox "VBA Password is Removed!", vbInformation, "Excel Tool"
End If
```
Từ lúc này mọi cuộc gọi hàm DialogBoxParam thì thực chất là gọi hàm nhái MyDialogBoxParam
mà nó sẽ trả về 1, tức Excel sau đó kiểm tra thấy 1 được trả về thì tưởng rằng user nhập đúng mật
khẩu và nhấn OK – y như cái procedure của hộp thoại mà nó thiết kế trả về khi user nhập đúng mật
khẩu và nhấn OK.
c – Ta nhấn VBAProject để xem và copy code
d – Ta nhấn "Trả lại" để thực hiện code RecoverBytes. Nó sẽ trả lại (trong RAM) địa chỉ cũ của hàm
DialogBoxParam.
—————–
Nói đến test thì tôi lại là vua lười.
Vậy ndu hãy test và thông báo kết quả thế nào

http://www.giaiphapexcel.com/diendan/threads/c%C3%B3-th%E1%BB%83-d%C3%B9ng-vba-%C4%91%E1%BB%83-x%C3%B3a-vba-%C4%91c-kh%C3%B4ng.72632/post-444901

Cái này để mình bàn trong 1 dịp khác nha anh (vi phạm nội quy đấy)

Reply
hands says:

18/01/2023 at 2:43 pm

Trời ơi! Lợi hại quá, password là cái quỷ gì nó cũng remove tuốt
Ghê gớm hơn nữa là:
– Tôi tạo 1 file khác có pass VBA
– Tiếp theo mở file của siwtom lên đồng thời với file mới vừa tạo rồi nhấn nút Đánh tráo
– Kết quả nhận được là: "cánh cửa" đã được mở cho cả 2 file luôn
– Thử nghiệm tiếp trên 3, 4 file có password, cứ chạy code của siwtom là xem như "mời vào nhà!"
——————-
Anh đúng là hacker siêu hạng

Không phải, hiểu lầm nhau rồi.
Code là của tác giả tập tin mà quanghai gửi lên. Tất nhiên tôi cũng từng viết trong Delphi để đánh tráo hàm nhưng cái code này đã có sẵn nên chả cần viết gì cả.
Chỉ có điều tôi biết về "kỹ thuật đánh tráo" nên chỉ đọc lướt qua code của tập tin do quanghai gửi lên thì tôi nhận ra ngay là nó đã làm thế nào. Do hiểu được nên tôi sửa chút để không hiển thị Form nào cả mà "đánh tráo" lúc nào" và "Trả về" thế nào. Chỉ thế thôi.

Mà code không Remove password. Nói ngắn gọn thì thế này:
Excel gọi hàm của system để hiển thị hộp thoại. Nếu user nhập đúng password và nhấn OK thì hàm trả về 1. Nếu nhấn Cancel hoặc nhập sai password thì trả về 0. Khi hộp thoại đóng thì Excel kiểm tra kết quả trả về của hàm vừa gọi. Nếu là 1 thì nó "cho là" user nhập đúng password và nhấn OK. Vậy nó mở cho user xem code. Không phải xóa password vì lần sau mở ra thì lại phải đánh tráo mới xem được.
Bây giờ ta đánh tráo sang là gọi hàm "nhái" của ta. Hàm nhái chả hiển thị cóc khô gì mà về luôn cùng với giá trị 1. Và Excel kiểm tra giá trị trả về thì thấy là 1 nên "tưởng" là user nhập đúng password và nhấn OK

Công to là của quanghai sưu tầm.

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!_)()(-
—————-
Ẹc… Ẹc… Từ nay thì mấy "chú tào lao" đừng mong mà Pass VBA code gì nữa nhé —> Nếu siêu thì cứ tạo DLL đi, còn không thôi (có đặt pass của uổng công)
//..,,

Nếu sốc thật thì cũng dể hiểu thôi. Không phải vô cớ mà chuyện đánh tráo hàm này là một trong những món "đặc sản" của hacker và rootkit. Họ là những người rất am tường về system, hiểu cơ cấu và cách thức hoạt động của system nên họ có thể đột nhập vào system để làm mưa làm gió.
Ngay như đột nhập vào một căn nhà có hệ thống cảnh báo chẳng hạn. Người thường thì không biết cách nhưng người am tường thì biết vào đường nào. Cửa chính, phụ? Qua đường hệ thống thông gió? Chỗ nào là điểm yếu của căn nhà? Vào rồi thì do am tường về các hệ thống cảnh báo nên họ biết phải "tắt" cái gì, tắt ở đâu v…v

Còn về "thuật toán" thì đơn giản thôi.
Giả dụ ta có ông A (system Windows) trực. Khi khách hàng gọi điện tới đặt ông sửa ống nước chẳng hạn (process gọi hàm Windows – SuaOngNuoc) thì ông A "đi" tới bảng ghi số điện thoại và đọc số của ông sửa ống nước (mỗi ngày có 1 ông khác với số khác – tương đương với mỗi lần DLL được load vào RAM thì nó nằm ở một địa chỉ khác), sau đó gọi cho ông thợ (nhẩy tới địa chỉ của hàm) và "kích hoạt", "cử" ông thợ đi làm (thực hiện code ở địa chỉ vừa nhẩy tới).
Thế bây giờ nếu ta "lén" sửa lại số điện thoại được ghi trên bảng và thay vào đó ghi số của nhân viên của ta thì sao? Thì ông A sẽ gọi cho nhân viên của ta và "cử" nhân viên củ ta đi làm, thế thôi.
………………………
b – Trước tiên ta nhấn "Đánh tráo", code của nó là:
```
If Hook Then
        MsgBox "VBA Password is Removed!", vbInformation, "Excel Tool"
End If
```
………………………..
Mình không hiểu code này gọi hàm (thủ tục) kiểu gì? Đâu thấy call Hook, chỉ là một thông báo!
(Giống kiểu phát ngôn gây "sốc" hoặc là thần chú gì đó?)
Bạn nào giải thích giùm!
Hàm Hook này là dạng boolean luôn trả về TRUE khi hoàn tất thủ tục, mở đầu Hook = False và kết thúc hàm là Hook = True

Theo em nghĩ, Khi ta dùng IF HOOK THEN tức là ta đã "gián tiếp" gọi hàm đó, dĩ nhiên nó phải kiểm tra HOOK và từ đó HOOK chạy từ False rồi thực hiện thủ tục, sau cùng trả về TRUE.
```
Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long

[COLOR=#ff0000][B]Hook = False[/B][/COLOR]

'........................................
            [B][COLOR=#0000cd]Hook = True[/COLOR][/B]
        End If
    End If
End Function
```
Hay nhỉ?
Mình mở một file mới và chạy đoạn code

Sub test()
Dim Hook As Boolean
MsgBox Hook
End Sub

Kết quả luôn là False. Tức là Hook đã có giá trị rồi mà hàm Hook vẫn làm việc?

Tầm trình độ của chúng ta thường hay viết khác:
– Viết code cho Sub Hook (chứ không phải Function)
– Dùng 1 biến public chk kiểu Boolean để kiểm tra xem Sub Hook đã chạy hoàn tất chưa
– Xong, viết 1 Sub khác cho gọi sub Hook, đồng thơi kiểm tra biến chk, nếu chk=TRUE thì sẽ làm việc khác
```
Public chk as Boolean
Sub Hook()
  If.... gì gì đo then  
     chk = True
  End If
End Sub
Sub Main
  Call Hook
  If chk then
    'Làm việc khac
  End If
End Sub
```
Tuy nhiên, các nhà lập trình chuyên nghiệp thường hay viết kiểu khác: Thay đổi Sub Hook thành Function Hook và Function này trả về giá trị kiểu Boolean luôn.
Vậy nếu code trong Hook hoàn tất thì hàm trả về kết quả = TRUE và ngược lại
Cách này có cái tiện là khỏi cần phải qua biến tạm dạng Public
——————-

Hay nhỉ?
Mình mở một file mới và chạy đoạn code

Sub test()
Dim Hook As Boolean
MsgBox Hook
End Sub

Kết quả luôn là False. Tức là Hook đã có giá trị rồi mà hàm Hook vẫn làm việc?

Anh viết vậy không đúng —> Biến Hook của anh hóa ra trùng với tên hàm à
Lý ra chỉ vầy là được
```
Sub test()
MsgBox Hook
End Sub
```
Với HOOK là một hàm trả về giá trị BOOLEAN, còn một đằng khai báo biến HOOK là một BOOLEAN, 2 trường hợp này hoàn toàn khác nhau.

Với hàm HOOK nó có tính Public, còn trong cái SUB của anh, biến HOOK chỉ là chạy "nội tại" mà đã là "nội tại" thì nó sẽ chạy trước, public nó chạy sau nếu nội tại không thỏa, tức chạy hết SUB nó sẽ hết tác dụng khi END SUB. Mặt khác, với HOOK trong SUB của anh nó chưa định giá trị TRUE hoặc FALSE cho nó vì vậy mặc định của biến này luôn là FALSE.

Thí nghiệm như vầy, cũng trên file đó, anh đặt Dim Hook As Boolean ở trên cùng rồi chạy thủ tục dưới đây như sau:
```
[COLOR=#ff0000][B]Dim Hook As Boolean[/B][/COLOR]

'-----------------------------
Sub test()
    If Hook Then
        MsgBox "VBA Password is Removed!", vbInformation, "Excel Tool"
    End If
End Sub
```
Cho chạy Sub test bảo đảm với anh nó không thông báo gì cả!

Từ thí nghiệm này cho thấy, khi chạy thủ tục, nếu trùng tên Hàm/Sub nó sẽ thông báo lỗi, nếu Hàm trùng tên Biến, nó sẽ xét theo Biến.
Reply
hands says:

18/01/2023 at 2:45 pm
Mình không hiểu code này gọi hàm (thủ tục) kiểu gì? Đâu thấy call Hook, chỉ là một thông báo!
(Giống kiểu phát ngôn gây "sốc" hoặc là thần chú gì đó?)
Bạn nào giải thích giùm!
```
Sub Button1_Click()
    If Hook Then
        MsgBox "VBA Password is Removed!", vbInformation, "Excel Tool"
    End If
End Sub
```
Trong VBA để gọi Hook ta có thể viết Hook hoặc Call Hook

Nếu không cần thông báo thì code trên chỉ cần viết Hook là đủ
```
Sub Button1_Click()   
Hook
End Sub
```
Mình biết rồi, nhưng ở đây là If Hook nên mới siêu!
Vẫn chỉ là cách viết thay vì If Hook = True Then người ta viết If Hook Then cho nó khỏe (nghe nói code chạy nhanh hơn)
```
Sub Button1_Click()
    If Hook = True Then
        MsgBox "VBA Password is Removed!", vbInformation, "Excel Tool"
    End If
End Sub
```
Thì cũng giống vầy thôi
```
Function [COLOR=#ff0000]SheetExist[/COLOR](WorkSheetName As String) [COLOR=#ff0000]As Boolean[/COLOR]
  On Error Resume Next
  SheetExist = Not Sheets(WorkSheetName) Is Nothing
End Function
Sub Main
  If [COLOR=#ff0000]SheetExist("ABC") [/COLOR]then
    MsgBox "Sheet 'ABC' này ton tai"
  End If
End Sub
```
Em không nghĩ là anh lại thắc mắc chuyện đơn giản này
Ẹc… Ẹc…
Lại hiểu sai ý của mình rồi!
Nếu như trước loạt bài này, muốn viết code Main trên thì mình phải viết là
```
Sub Main()
    [COLOR=#ff0000]SheetExist ("ABC")    [/COLOR]' Hoac Call SheetExist("ABC")
    If SheetExist("ABC") Then
        MsgBox "Sheet 'ABC' này ton tai"
    End If
End Sub
```
Anh viết vậy là… quá thừa rồi còn gì
SheetExist là 1 Function chứ đâu phải 1 Sub —> Nếu nó chạy thì nó phải trả về giá trị gì đó và ta phải "nhận" lấy để tính toán xem sẽ làm gì tiếp
Còn cách anh vừa viết là anh đã tự xem SheetExist là 1 Sub (không phải Function) và giá trị trả về của nó anh cũng không thèm đếm xỉa đến luôn….
Dòng đỏ ở trên chẳng biết để làm cái gì nữa, có chăng thì vầy mới hợp lý:
```
Sub Main()
  Dim bChk as Boolean
  bChk = SheetExist ("ABC")
  If bChk Then
    MsgBox "Sheet 'ABC' này ton tai"
  End If
End Sub
```
Nói cho cùng thì cũng y chang cách em đã viết ở bài 57 thôi
Ẹc… Ẹc… (ngộ hen.. tự nhiên anh lại théc méc rất.. kỳ cục…)

Ờ, đúng ý mình đó, nếu trước đây, mình sẽ viết vậy! Dốt quá.

Reply
hands says:

18/01/2023 at 2:58 pm

Mình biết rồi, nhưng ở đây là If Hook nên mới siêu!

Bạn có 3 cách viết:
1.
a = Hook
if a then
2. if Hook = TRUE then
3. if Hook then
————
Bạn biết gì về cấu trúc: IF đk THEN?
đk là biểu thức trả về giá trị lôgíc – boolean.
Khi gặp cấu trúc IF đk … thì trước tiên biểu thức đk được tính giá trị, sau đó tùy giá trị thế nào mà thực hiện code.
Ta có các biến lôgíc, các hàm trả về giá trị lôgíc … Chúng được kết nối với nhau bởi OR, AND, và >, <, >=, <=, = (với 2 vế không nhất thiết là các giá trị lôgíc).
Với a, b, HamGiDo(…) as boolean, c, d as Long thì:
TRUE, FALSE, a, b, HamGiDo, (a or b), (a or b) and HamGiDo, c = d, (c = d) and b, c >=<= d v…v đều là biểu thức.
Có thể nói TRUE, FALSE, a, b, HamGiDo là những biểu thức đơn.
Với IF HamGiDo THEN thì cũng như mọi khi thôi, tức trước tiên cần tính giá trị của "biểu thức" HamGiDo. Việc tính giá trị của biểu thức HamGiDo là việc xác định giá trị trả về bởi HàmGiDo, tức code của HamGiDo phải được thực hiện và giá trị trả về sau khi thực hiện code là giá trị của biểu thức.
Hàm Hook sau khi thực thi thì trả về giá trị Boolean cũng chính là giá trị của biểu thức điều kiện, thế thôi.
Khi bạn tính biểu thức trong đó có sin(x) (Riêng sin(x) cũng là biểu thức rồi) thì bạn "bấm" máy tính tay (tức thực hiện code tính sin): x –> sin, còn khi máy nó gặp HamGiDo thì nó "thực hiện code" của HamGiDo và có kết quả do hàm trả về.
Kiểu viết 2 và 3 như trên kết quả là như nhau nhưng thực hiện có sự khác nhau đấy nhé.
Ta tính giá trị của biểu thức (a = b), a và b có thể có dạng tổng quát vd. a = x + y, b = k + l + m + n
Việc tính được giá trị của a hay b vẫn chưa xong. Giá trị của biểu thức (a = b) được tính như sau:
1. tính a
2. tính b
3. tính a = b (so sánh)
Với a, b as boolean tương tự. Tính được a hay b TRUE hay FALSE vẫn chưa kết luận được gì về giá trị của biểu thức a = b. a có thể = FALSE, b = FALSE nhưng a = b = TRUE.
Với IF Hook then thì có được giá trị trả về của Hook cũng chính là giá trị của đk thì việc xác định đk kết thúc.
Với IF Hook = TRUE then thì dù có được giá trị do Hook trả về thì giá trị của đk vẫn chưa được xác định. Phải thực hiện phép so sánh Hook = TRUE mới có được giá trị của đk.
————
Cũng nên nhớ là nếu bạn có hàm Hichic và bạn viết: call Hichic (Hichic) thì có nghĩa là: code của Hichic được thực hiện nhưng kết quả trả về không dùng làm gì cả, không được lưu ở đâu cả.
Nhưng khi bạn có:
a = Hichic
b = 5 + Hichic
IF Hichic > a + sin(xyz) THEN
….
Thì không chỉ là code của Hichic được thực thi mà giá trị do nó trả về còn dùng cho các tính toán tiếp theo.
Vì vậy với cùng một hàm Hichic thì "chỗ này" bạn cần giá trị do hàm trả về thì bạn viết: a = Hichic, nhưng ở "chỗ khác" bạn không cần giá trị trả về mà chỉ cần thực thi code thôi (hàm không chỉ trả về giá trị mà hàm có thể làm nhiều việc trong code) thì bạn viết: call Hichic. Bạn có thể viết a = Hichic nếu muốn nhưng không bắt buộc.

Em hiểu cái khác file quangha là không cho view project là file Bác không mở được???
Bác cho em hỏi khắc phục nó như thế nào. Bây giờ file em muốn như thế thì làm như thế nào?
Cảm ơn Bác

Tôi đã viết rồi. Bạn đặt mật khẩu thì Excel hiển thị hộp thoại bắt bạn nhập rồi khi đóng hộp thoại thì Excel kiểm tra xem kết quả có "thỏa mãn" nó không, nếu có thì "mở". Do Excel gọi hàm của system để tạo hộp thoại nên mới có cơ hội đánh tráo hàm này bằng hàm của ta, mà hàm của ta chả hiển thị hộp thoại nào cả và trả về kết quả "thỏa mãn" Excel. Thế thôi.
Còn khi mà "người ta" không gọi gì cả để hiển thị hộp thoại nhập mật khẩu ("người ta" có đòi hỏi gì đâu mà hiển thị hộp thoại nhập mật khẩu?) thì tráo cái gì? Mà tráo cái gì, để làm gì? "Người ta" có cần kết quả nào đâu? "Người ta" đá đít mình luôn chứ có yêu cầu gì đâu?
Tôi đã nói rồi. Với dạng file như của quanghai thì bạn thử … đọc ký chủ đề này đi. Bệnh khác thì phải dùng thuốc khác. Trong chủ đề có nói chút về thuốc mà.

Vấn đề Unviewable em đã gặp và đã tìm được cách giải quyết từ hơn 1 năm về trước, và ngay trên diễn đàn tác giả Trần Thanh Phong cũng đã có những bài viết về vấn đề này (CMG, DPB, GC). Thực sự việc bảo mật Code cũng đã được nói rất nhiều, bàn rất nhiều, lộ thông tin, lộ bảo mật, mất dữ liệu…v.v.. Nhưng với trình độ không chuyên, mày mò, vật lộn với VBA cơ bản như em thì mớ Code ấy chưa là gì cả. Khi các anh chị chuyên IT viết phần mềm tức khắc các anh chị biết cách bảo mật. Về Topic này em nghĩ vẫn sẽ là nơi trao đổi bảo mật Excel trong giới hạn không chuyên.(Nếu chủ topic không có nhã ý thì đề nghị Mod cho 1 topic về bảo mật Version mới để các thành viên hỏi đáp). Những người tham gia diễn đàn này hầu hết có ý thức về Code, về Excel…vậy nên hỏi để biết, hỏi để tìm hiểu cũng là 1 nhu cầu chính đáng.
Xin cảm ơn!

À mà "muốn như thế" có nghĩa là gì?
Là muốn bỏ "Project is unviewable"? Nếu thế thì đọc bài của dhn46
Là muốn bắt chước người ta làm "Project is unviewable"?
————
Một khi ta đã biết là nếu cần bỏ "Project is unviewable" thì trong HexEditor ta có thể sửa CMG,
DPB, GC thì để làm được "Project is unviewable" ta cũng "tìm" ở "chỗ đó" thôi.
Tôi đã thử "vài cái" thì thấy làm cũng đơn giản thôi.
Tôi chỉ cách tốn ít thao tác nhất.
Bạn mở HexEditor –> chọn trong HexEditor để mở tập tin Excel mà bạn cần thao tác.
Chọn Search và tìm CMG. Bạn sẽ thấy đại loại là CMG="C4C6276D2F3533353335333533"
Bạn hãy sửa 1 ký tự trong ngoặc " " sang ký tự khác thuộc tập . Bạn có thể sửa tất cả các ký tự nhưng ta đã
thống nhất với nhau là ít thao tác nhất rồi mà.
Ở lân cận CMG cũng có đại loại DPB="…". Bạn cũng sửa 1 ký tự trong ngoặc. Rồi ở gần có
GC="…". Làm tương tự. Save lại tập tin. Xong
Mang đi "dọa" đồng nghiệp

Không có vấn đề gì cả, Nếu có thể được các Bác cứ trao đổi ở chủ đề này thoải mái thoải mái những vấn đề liên quan càng sôi nổi càng tốt.
Mới đầu các Bác lo ngại có chiều hướng không hay! Nhưng mọi việc đã được nhin nhận theo chiều hướng khá tốt rồi!
Đã đến nước này rồi thì cứ tơi lên các bác à!

Do em không biết có cách nào mở file trong trường hợp Project is unviewable không? Nhưng với file của anh siwtom thì chưa thành công anh à.

– Mở file bằng Hexeditor
– Xóa sạch hết từ CMG đến GC
– Lưu file lại
– Mở file lên kiểm tra —> Bất cứ thằng Unview hay Protect VBA gì gì đó cũng sẽ đi.. Pháp ở

Theo như clip Sư phụ gửi không biết dùng lệnh gì trong việc "xóa sạch hết từ CMG đến GC" (quét vùng và nhấn Delete?) thì vùng chọn đó thay thế bằng "…………",
Em quét vùng và nhấn Delete thì xóa mất hết luôn, lưu lại mở ra thì báo mất code trong VBE luôn (báo lỗi như bài viết của Hong.Van). Nếu thay tất cả các ký tự vùng đó (từ CMG đến GC) bằng các dấu "…….." thì được. Ở đây em đang hỏi lý do Sư phụ làm được nhanh như thế ? em cũng mong mở được trong vòng 3s ẹc.. ẹc ..

Thế bạn trở thành dũng sỹ diệt code rồi, ha ha…
Nói vậy chớ xóa hết từ chữ "CMG" đến hết nội dung của GC, khi nào thành một loạt dấu …….(chấm) là được.
Hình như hôm trước tôi gửi video clip cho bạn rồi mà

KnrSHYUjZhE

Thì làm giống y chang như tôi đã làm thôi (trước giờ chưa từng bị bất kỳ lỗi gì)
Chú ý:
– Ctrl + F
– Đặt con trỏ chuột về phía bên phải số 47 rồi bấm Delete 3 phát
– Xong, đặt chuột vào ô vuông màu xanh, gõ CMG và bấm nút Find
Nói chung cứ chú ý kỹ thao tác tôi làm trong video clip là được rồi

UEea2PXp4eY

Trước hết cần lưu ý là không phải HexEditor nào cũng như nhau. Vd. với HE nghèo nàn như của tôi thì bạn không thể thao tác như ndu hướng dẫn (đặt trỏ sau 47 và Delete 3 phát …)
Bạn làm thế này.
Mở XLS –> Tìm CMG –> click vào G (ký tự cuối) –> gõ x –> nhìn xuống dưới (sau CMG="…") có DPB –> click vào B –> gõ x –> nhìn xuống dưới có GC –> click vào C –> gõ x
(cuối cùng ta có CMx, DPx, Gx)
–> Save
–> mở XLS bằng Excel –> có hỏi gì thì cứ OK (3 lần) –> khi mở xong thì chọn Save –> từ lần mở sau Excel không hỏi gì nữa
Khỏi cần Video hướng dẫn.
———-
Nếu HexEditor của bạn không click được vào G, B, C để đánh dấu và khi gõ x thì thay thế thì tôi đã đính kèm HexEditor ở dưới.

Reply
hands says:

18/01/2023 at 3:20 pm

Em cảm ơn các Thầy & anh chị!
Trước khi có bài gỡ PW của anh thì em đã dùng chương trình Office Password Recovery Toolbox, chương trình này chỉ gỡ PW BAV thông thường chứkg gỡ thằng Unviewable được!
Em có nghiên cứu một số trang như
https://www.pcreview.co.uk/forums/help-vba-password-lost-t3161183.html
…
Nhưng chưa được….
Có lẽ có nhiều nguyên do như chương trình Hexeditor của em dùng Free nên thiếu các chức năng, ví dụ như chương trình của Thầy Ndu khi bấm Ctrl+F nó ra cái khung khác, của em cái khung khác …
——–
Nhân tiện đây cho em hỏi: những File Excel đã chuyển qua .exe thì có thể chuyển về .xls được không?
Em cảm ơn!

Tôi nghĩ là cái EXE kia chỉ là trá hình thôi. Từ đâu nó có "nội dung" file Excel để mà mở bằng Excel?
Vì vậy tôi nghĩ là toàn bộ nội dung file Excel "thằng" EXE kia nó có "trong cơ thể nó". Tức người viết code EXE "đính kèm" file Excel ở dạng resource (chuẩn), hoặc làm kiểu a ma tơ thì khi làm xong EXE thì dùng phần mềm "nối" file Excel vào đuôi EXE.
Khi EXE được kích hoạt thì nó "bung" file Excel từ resource, hoặc cắt từ đuôi EXE (tất nhiên cắt từ đâu thì cái phần mềm kia sẽ ghi, vd. 4 bai ở đuôi EXE sẽ dùng để ghi độ lớn của file Excel –> khi được kích hoạt thì EXE nhẩy tới 4 bai cuối để đọc độ lớn của file Excel, giả dụ là x –> EXE nhẩy tới bai cách bai cuối cùng (offset tính từ cuối) là x + 4 rồi đọc x bai – tóm lại phần mềm kia trước tiện ghi file Excel vào đuôi EXE sau đó ghi tiếp trong 4 bai độ lớn của file EXE, tổng cộng số bai ghi vào đuôi EXE là x + 4. Khi đọc ra thì EXE đọc 4 bai cuối để có x, sau đó nhẩy xuống cuối EXE "thực", tức offset = x + 4 tính từ cuối rồi đọc x bai liên tiếp), ghi lên đĩa
Do việc "nhúng" file Excel vào EXE có thể có nhiều cách (resource, a ma tơ) nên khó nói là lọc file Excel từ EXE như thế nào.
Nếu bạn đã từng dùng phần mềm để "convert" file Excel thành EXE thì hãy gửi lên cho tôi phần mềm đó. Tôi sẽ thử xem nó làm như thế nào. Nếu đúng là nó "nhúng" file Excel vào EXE thì chuyện tách ra không có gì là khó. Chỉ sợ là trước khi nhúng nó mã file Excel thì chịu vì biết nó mã thế nào để mà giải mã?
—————–
Mà nếu đúng là khi được kích hoạt nó sẽ "bung" file Excel từ trong "cơ thể" nó rồi ghi trên đĩa cững để gọi Excel mở thì chỉ cần dò xem nó ghi ở đâu trên đĩa cứng thì lấy thôi. Cái dò này thì ai cũng làm được.
Bạn có file Excel đã được "convert" sang EXE không? Nếu không có gì bí mật thì gửi cho tôi xem.
————–
Tất nhiên có thể mỗi thằng làm một khác, và không nhất thiết như tôi nói. Do có thể mỗi thằng làm một khác nên để biết chúng làm thế nào thì phải xét từng thằng cụ thể.
Vd. nếu bạn dùng thằng này

https://www.drmsoft.com/Excel-to-exe-converter.asp

thì tôi nghĩ việc lấy được file nguồn là hoàn toàn dễ dàng. Ít ra thì tôi cũng đã thử dùng nó để convert 1 file Excel sang EXE rồi khi kích hoạt EXE thì tôi lấy được file nguồn.

Chào anh!
Em kg sử dụng và tạo File .exe. Vì có tạo thì em fải thủ trước 1 File dự trữ rồi
Tình hình là như thế này, trước đây em có xem 1 File .exe chạy chương trình kế toán của 1 người bạn làm ở cty khác, em muốn bổ sung thêm một số đoạn code mà em sưu tầm được vào chương trình này. Vì thế em hỏi muốn chuyển từ File .exe về File .xls.
Sáng nay em có hỏi nó để lấy fần mềm này, nhưng chắc nó sợ lộ thông tin số liệu và sếp nó, nên nó kg muốn chuyển.
Em cảm ơn!

Dùng Hex Editor để mở Unviewable của VBA, nhưng đối với dạng .xla thì mình làm thế nào để mở Unviewable hả các anh?

Đây là project trên Excel 5.0/95 nên khi mở ra trên Excel 2007 thì có thông báo và VBA bị loại hết.
Của quanghai và Hong.Van đều như vậy.

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!

' Setup & Registering functions

Sub auto_open()
Application.EnableCancelKey = xlDisabled
SetupFunctionIDs
PickPlatform
VerifyOpen
RegisterFunctionIDs
End Sub

' O12:624902 – unregister analys32.xll if it's not installed so that funcres.xlam
' closes and the UI is removed
Sub auto_close()
Dim fATPInstalled As Boolean

fATPInstalled = False
For Each ai In Application.AddIns
If UCase(ai.Name) = "ANALYS32.XLL" Then
fATPInstalled = ai.Installed
Exit For
End If
Next ai

If Not fATPInstalled Then
Application.ExecuteExcel4Macro ("unregister(""analys32.xll"")")
End If

End Sub

Private Sub VerifyOpen()
XLLName = ThisWorkbook.Sheets("Loc Table").Range(XLLNameCell).Value
theArray = Application.RegisteredFunctions
If Not (IsNull(theArray)) Then
For i = LBound(theArray) To UBound(theArray)
If (InStr(theArray(i, 1), XLLName)) Then
Exit Sub
End If
Next i
End If

Quote = String(1, 34)
ThisWorkbook.Sheets("REG").Activate
WorkbookName = "" & Sheet1.Name
AnalysisPath = ThisWorkbook.Path

AnalysisPath = AnalysisPath & DirSep
XLLFound = Application.RegisterXLL(AnalysisPath & XLLName)
If (XLLFound) Then
Exit Sub
End If

AnalysisPath = ""
XLLFound = Application.RegisterXLL(AnalysisPath & XLLName)
If (XLLFound) Then
Exit Sub
End If

AnalysisPath = LibPath
XLLFound = Application.RegisterXLL(AnalysisPath & XLLName)
If (XLLFound) Then
Exit Sub
End If

XLLNotFoundErr = ThisWorkbook.Sheets("Loc Table").Range("B12").Value
MsgBox (XLLNotFoundErr)
ThisWorkbook.Close (False)
End Sub

Private Sub PickPlatform()
Dim Platform

ThisWorkbook.Sheets("REG").Activate
Range("C3").Select
Platform = Application.ExecuteExcel4Macro("LEFT(GET.WORKSPACE(1),3)")
If (Platform = "Mac") Then
DirSep = ThisWorkbook.Sheets("Loc Table").Range(MacDirSepCell).Value
LibPath = ThisWorkbook.Sheets("Loc Table").Range(LibPathMacCell).Value
Else
DirSep = ThisWorkbook.Sheets("Loc Table").Range(WinDirSepCell).Value
LibPath = ThisWorkbook.Sheets("Loc Table").Range(LibPathWinCell).Value
End If
End Sub

Private Sub RegisterFunctionIDs()
XLLName = ThisWorkbook.Sheets("Loc Table").Range(XLLNameCell).Value
Quote = String(1, 34)
For i = LBound(FunctionIDs) To UBound(FunctionIDs)
Dim StrCall
StrCall = "REGISTER.ID(" & Quote & AnalysisPath & XLLName & Quote & "," & Quote & FunctionIDs(i, 0) & Quote & ")"
FunctionIDs(i, 1) = ExecuteExcel4Macro(StrCall)
Next i
End Sub

Private Sub SetupFunctionIDs()
FunctionIDs(0, 0) = "fnAnova1"
FunctionIDs(1, 0) = "fnAnova2"
FunctionIDs(2, 0) = "fnAnova3"
FunctionIDs(3, 0) = "fnMCorrel"
FunctionIDs(4, 0) = "fnMCovar"
FunctionIDs(5, 0) = "fnDescr"
FunctionIDs(6, 0) = "fnExpon"
FunctionIDs(7, 0) = "fnFourier"
FunctionIDs(8, 0) = "fnFtestV"
FunctionIDs(9, 0) = "fnHistogram"
FunctionIDs(10, 0) = "fnMoveAvg"
FunctionIDs(11, 0) = "fnRandom"
FunctionIDs(12, 0) = "fnRankPerc"
FunctionIDs(13, 0) = "fnRegress"
FunctionIDs(14, 0) = "fnSample"
FunctionIDs(15, 0) = "fnTtestM"
FunctionIDs(16, 0) = "fnTtestUeq"
FunctionIDs(17, 0) = "fnTtestEq"
FunctionIDs(18, 0) = "fnZtestM"
FunctionIDs(19, 0) = "fnAnova1Q"
FunctionIDs(20, 0) = "fnAnova2Q"
FunctionIDs(21, 0) = "fnAnova3Q"
FunctionIDs(22, 0) = "fnMCorrelQ"
FunctionIDs(23, 0) = "fnMCovarQ"
FunctionIDs(24, 0) = "fnDescrQ"
FunctionIDs(25, 0) = "fnExponQ"
FunctionIDs(26, 0) = "fnFourierQ"
FunctionIDs(27, 0) = "fnFtestVQ"
FunctionIDs(28, 0) = "fnHistogramQ"
FunctionIDs(29, 0) = "fnMoveAvgQ"
FunctionIDs(30, 0) = "fnRandomQ"
FunctionIDs(31, 0) = "fnRankPercQ"
FunctionIDs(32, 0) = "fnRegressQ"
FunctionIDs(33, 0) = "fnSampleQ"
FunctionIDs(34, 0) = "fnTtestMQ"
FunctionIDs(35, 0) = "fnTtestUeqQ"
FunctionIDs(36, 0) = "fnTtestEqQ"
FunctionIDs(37, 0) = "fnZtestMQ"
End Sub

Tiếp!
' ANALYSIS TOOLPAK – Excel AddIn
' The following function declarations provide interface between VBA and ATP XLL.

' These variables point to the corresponding cell in the Loc Table sheet.
Const XLLNameCell = "B8"
Const MacDirSepCell = "B3"
Const WinDirSepCell = "B4"
Const LibPathWinCell = "B10"
Const LibPathMacCell = "B11"

Dim DirSep As String
Dim LibPath As String
Dim AnalysisPath As String
Dim WorkbookName As String

Dim FunctionIDs(37, 0 To 1)

Private Function GetMacroRegId(FuncText As String) As String
For i = LBound(FunctionIDs) To UBound(FunctionIDs)
If (LCase(FunctionIDs(i, 0)) = LCase(FuncText)) Then
If (Not (IsError(FunctionIDs(i, 1)))) Then
GetMacroRegId = FunctionIDs(i, 1)
Exit Function
End If
End If
Next i
End Function

'Procedures

Sub Anova1(inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant, Optional alpha As Variant)
xAnova1 = Application.Run(GetMacroRegId("fnAnova1"), inprng, outrng, grouped, labels, alpha)
End Sub

Sub Anova1Q(Optional inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant, Optional alpha As Variant)
xAnova1Q = Application.Run(GetMacroRegId("fnAnova1Q"), inprng, outrng, grouped, labels, alpha)
End Sub

Sub Anova2(inprng As Variant, Optional outrng As Variant, Optional sample_rows As Variant, Optional alpha As Variant)
xAnova2 = Application.Run(GetMacroRegId("fnAnova2"), inprng, outrng, sample_rows, alpha)
End Sub

Sub Anova2Q(Optional inprng As Variant, Optional outrng As Variant, Optional sample_rows As Variant, Optional alpha As Variant)
xAnova2Q = Application.Run(GetMacroRegId("fnAnova2Q"), inprng, outrng, sample_rows, alpha)
End Sub

Sub Anova3(inprng As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant)
xAnova3 = Application.Run(GetMacroRegId("fnAnova3"), inprng, outrng, labels, alpha)
End Sub

Sub Anova3Q(Optional inprng As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant)
xAnova3Q = Application.Run(GetMacroRegId("fnAnova3Q"), inprng, outrng, labels, alpha)
End Sub

Sub Descr(inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant, Optional summary As Variant, Optional ds_large As Variant, Optional ds_small As Variant, Optional confid As Variant)
xDescr = Application.Run(GetMacroRegId("fnDescr"), inprng, outrng, grouped, labels, summary, ds_large, ds_small, confid)
End Sub

Sub DescrQ(Optional inprng As Variant, Optional outrng As Variant, Optional grouped As Variant, Optional labels As Variant, Optional summary As Variant, Optional ds_large As Variant, Optional ds_small As Variant, Optional confid As Variant)
xDescrQ = Application.Run(GetMacroRegId("fnDescrQ"), inprng, outrng, grouped, labels, summary, ds_large, ds_small, confid)
End Sub

Sub Expon(inprng As Variant, Optional outrng As Variant, Optional damp As Variant, Optional stderrs As Variant, Optional chart As Variant, Optional labels As Variant)
xExpon = Application.Run(GetMacroRegId("fnExpon"), inprng, outrng, damp, stderrs, chart, labels)
End Sub

Sub ExponQ(Optional inprng As Variant, Optional outrng As Variant, Optional damp As Variant, Optional stderrs As Variant, Optional chart As Variant, Optional labels As Variant)
xExponQ = Application.Run(GetMacroRegId("fnExponQ"), inprng, outrng, damp, stderrs, chart, labels)
End Sub

Sub Fourier(inprng As Variant, Optional outrng As Variant, Optional inverse As Variant, Optional labels As Variant)
xFourier = Application.Run(GetMacroRegId("fnFourier"), inprng, outrng, inverse, labels)
End Sub

Sub FourierQ(Optional inprng As Variant, Optional outrng As Variant, Optional inverse As Variant, Optional labels As Variant)
xFourierQ = Application.Run(GetMacroRegId("fnFourierQ"), inprng, outrng, inverse, labels)
End Sub

Sub Ftestv(inprng1 As Variant, inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant)
xFtestv = Application.Run(GetMacroRegId("fnFtestV"), inprng1, inprng2, outrng, labels, alpha)
End Sub

Sub FtestvQ(Optional inprng1 As Variant, Optional inprng2 As Variant, Optional outrng As Variant, Optional labels As Variant, Optional alpha As Variant)
xFtestvQ = Application.Run(GetMacroRegId("fnFtestVQ"), inprng1, inprng2, outrng, labels, alpha)
End Sub

Sub Histogram(inprng As Variant, Optional outrng As Variant, Optional binrng As Variant, Optional pareto As Variant, Optional chartc As Variant, Optional chart As Variant, Optional labels As Variant)
xHistogram = Application.Run(GetMacroRegId("fnHistogram"), inprng, outrng, binrng, pareto, chartc, chart, labels)
End Sub

Sub HistogramQ(Optional inprng As Variant, Optional outrng As Variant, Optional binrng As Variant, Optional pareto As Variant, Optional chartc As Variant, Optional chart As Variant, Optional labels As Variant)
xHistogramQ = Application.Run(GetMacroRegId("fnHistogramQ"), inprng, outrng, binrng, pareto, chartc, chart, labels)
End Sub
Tiếp

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

Tiếp!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

Reply

hands says:

16/04/2023 at 8:32 am

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…

Xin hỏi các chuyên gia có code nào xóa một sub trong module không?

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

hands says:

16/04/2023 at 8:33 am
```
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
```
Tuyệt quá có cả dịch nghĩa nữa! Tks Thầy!
***********************************
```
'vd. DeleteProcedureCode Workbooks("vbe.xls"), "module2", "tinh toan"
```
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"
Code là tổng quát mà.
Bạn định xóa code của một hàm, phương thức nào đó? Rõ ràng nó phải có tên, đúng không? Thì nhập tên đó vào chỗ ProcedureName, tức thay cho "tinh toan" thì nhập vd. "MySecretFunction", với "MySecretFunction" là tên của hàm, phương thức cần xóa. Hơn thế nữa "MySecretFunction" nằm trong một module nào đó, đúng không? Giả dụ nằm trong "MySecretModule" thì thay vì "module2" thì nhập "MySecretModule" vào chỗ DeleteFromModuleName. Tất nhiên cái "MySecretModule" nó có trong workbook nào đó, đúng không? Thì nhập workbook đó vào chỗ wb thay cho Workbooks("vbe.xls"). Tức có thể nhập: Workbooks("MySecretBook.xls"), Workbooks(Book1.xls), Workbooks(1) v…v

Ví dụ là ví dụ về cách gọi. Khi bạn gọi phương thức thì bạn phải truyền thông số cụ thể cho lần gọi ấy chứ.
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
```
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
```
Reply
hands says:

16/04/2023 at 8:34 am

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ứ.

Đương nhiên được chứ anh
Ví dụ code lấy các Procedures trong 1 Module

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

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!

Anh xem file dưới đây nhé
@ 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 ?
```
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.
Thì anh làm vầy
```
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:

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á

Ấ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.

Nói chung là phải chỉnh lại Trusted Center mới dùng được code trong topic này

Reply

hands says:

16/04/2023 at 8:40 am

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 !

Thì lỗi của bạn thôi. Lần sau đọc cho kỹ nhé.
Mà "xóa dòng" là không chính xác (xóa vài dòng trong SUB, trong MODULE? – làm gì có chuyện đó). Code xóa toàn bộ code của 1 hàm, phương thức có tên cho trước trong module có tên cho trước trong book cho trước.
Tôi thường đọc kỹ bài của người khác.
Code không xóa Module mà chỉ xóa hàm trong Module vì người hỏi viết: "Xin hỏi các chuyên gia có code nào xóa một sub trong module không"

———————–
Bạn viết code buồn cười thật. Sao bạn cứ gọi một code 2 lần kiểu như:

Arr = ListProcedures(Selection)
Selection(1, 2).Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(ListProcedures(Selection))

Bạn gọi 1 lần là được:

Arr = ListProcedures(Selection)
Selection(1, 2).Resize(UBound(Arr) + 1) = WorksheetFunction.Transpose(Arr)

————

Để bạn làm được các việc đã nêu thì tôi cho bạn những code dưới đây. Chú ý:
1. DeleteProcedureCode không chỉ xóa code của hàm và sub trong Module mà cả code trong UserForm, Sheet1, 2, 3, ThisWorkBook (với CompName = "UserForm1", "Sheet1", "ThisWorkBook")

2. Tôi viết các hàm liệt kê đòi hỏi thông số WorkBook vì tôi muốn viết hàm tổng quát thao tác trên WorkBook bất kỳ (khi có nhiều WorkBook mở cùng lúc) chứ không chỉ trên ActiveWorkBook.
Nếu bạn chỉ cần thao tác trên ActiveWorkBook thôi thì truyền ActiveWorkBook vào thông số.

' [COLOR=#ff0000]liệt kê các hàm, sub có 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ê các component (sheet, thisworkbook, userform, module, class module) có 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]xóa Module, Form, Class Module khỏ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]xóa nội dung củ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]xóa code của hà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

À, tôi là siwtom chứ không phải là Wistom

hands says:

16/04/2023 at 8:44 am

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.

Về yêu cầu của bạn là liệt kê và xóa các Function và Sub (macro) thì tôi đã gửi code.
Nhưng tôi muốn sửa 2 code để có thể liệt kê và xóa cả các property procedures (các property procedures Get, Let, Set trong class module)
Dưới đây tôi gửi lại code của Sub / Function. Những chỗ mầu đỏ là được thêm vào, chỗ mầu xanh là sửa (trước đó là vbext_pk_Proc, bây giờ là ProcKind)
Bây giờ thì tôi tin là code thao tác cho Sheet, ThisWorkbook, UserForm, Module và Class Module, tức "trọn gói".

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

hands says:

01/07/2023 at 4:40 pm

Excel VBA Breaker – 64 bit version

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

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

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

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

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

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

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As LongPtr
    Dim OriginProtect As LongPtr

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

p = GetPtr(AddressOf MyDialogBoxParam)

HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Module 2
Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

gist.github.com/OlivierHJ/852006307300a938c7f05f357b69922e

hands says:

01/07/2023 at 4:41 pm

You can try this direct VBA approach which doesn't require HEX editing. It will work for any files (*.xls, *.xlsm, *.xlam …).

Tested and works on:

Excel 2007
Excel 2010
Excel 2013 – 32 bit version
Excel 2016 – 32 bit version

Looking for 64 bit version? See [URL='stackoverflow.com/a/31005696/4342479']this answer

How it works

I will try my best to explain how it works – please excuse my English.

The VBE will call a system function to create the password dialog box.
If user enters the right password and click OK, this function returns 1. If user enters the wrong password or click Cancel, this function returns 0.
After the dialog box is closed, the VBE checks the returned value of the system function
if this value is 1, the VBE will "think" that the password is right, hence the locked VBA project will be opened.
The code below swaps the memory of the original function used to display the password dialog with a user defined function that will always return 1 when being called.

Using the code

Please backup your files first!

Open the file(s) that contain your locked VBA Projects

Create a new xlsm file and store this code in Module1
code credited to Siwtom (nick name), a Vietnamese developer

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

Private Function GetPtr(ByVal Value As Long) As Long
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

p = GetPtr(AddressOf MyDialogBoxParam)

HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                           hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Paste this code under the above code in Module1 and run it

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

Come back to your VBA Projects and enjoy.

hands says:

01/07/2023 at 4:41 pm

I've built upon Đức Thanh Nguyễn's fantastic answer to allow this method to work with 64-bit versions of Excel. I'm running Excel 2010 64-Bit on 64-Bit Windows 7.

Open the file(s) that contain your locked VBA Projects.

Create a new xlsm file and store this code in Module1

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

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

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

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

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

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

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As LongPtr
    Dim OriginProtect As LongPtr

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

p = GetPtr(AddressOf MyDialogBoxParam)

HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Paste this code in Module2 and run it

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

DISCLAIMER This worked for me and I have documented it here in the hope it will help someone out. I have not fully tested it. Please be sure to save all open files before proceeding with this option.

hands says:

01/07/2023 at 4:42 pm

Edit: this is an updated version of the accepted answer and should work on more office versions. It's tough but let's get this answer to the top!

With my turn, this is built upon kaybee99's excellent answer which is built upon Đức Thanh Nguyễn's fantastic answer to allow this method to work with both 32/64 bit versions of Office.

An overview of what is changed, we avoid push/ret which is limited to 32bit addresses and replace it with mov/jmp reg.

how it works

Open the file(s) that contain your locked VBA Projects.

Create a new file with the same type as the above and store this code in Module1

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 11) As Byte
    Dim p As LongPtr, osi As Byte
    Dim OriginProtect As LongPtr

Hook = False

#If Win64 Then
        osi = 1
    #Else
        osi = 0
    #End If

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

If VirtualProtect(ByVal pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, osi+1
        If TmpBytes(osi) <> &HB8 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 12

p = GetPtr(AddressOf MyDialogBoxParam)

If osi Then HookBytes(0) = &H48
            HookBytes(osi) = &HB8
            osi = osi + 1
            MoveMemory ByVal VarPtr(HookBytes(osi)), ByVal VarPtr(p), 4 * osi
            HookBytes(osi + 4 * osi) = &HFF
            HookBytes(osi + 4 * osi + 1) = &HE0

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 12
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Paste this code in Module2 and run it

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

stackoverflow.com/questions/1026483/is-there-a-way-to-crack-the-password-on-an-excel-vba-project/31005696#31005696

Cũ vẫn chất

#LabX – Addin khóa và mở khóa mã nguồn vbaProject

Nhờ kiểm tra khả năng bảo mật của Add-Ins

Tách các Quận, Huyện trong địa chỉ từ 1 danh sách nhập trước

Nhờ giúp rút gọn 1 chuỗi số.

Cách tạo dãy số từ hình ảnh

Dùng code lấy dữ liệu file data.txt

Xem thêm

Có thể dùng vba để xóa vba đc không?

Thiết kế Tổng đãi ngộ (Total Rewards) theo khung SHRM

Bạn nên đọc

Tìm ngày giờ kết thúc dự kiến

Tổng hợp file Excel tính giá thành sản phẩm cho doanh nghiệp sản xuất, gia công, xây lắp

Hướng dẫn xử lý file Excel chậm

Công thức quy đổi lương NET sang GROSS

Tính thưởng lũy tiến

Cách tách chuỗi trong dấu ngoặc Excel bằng công thức và Flash Fill

14 Responses

How it works

Using the code

Leave a Reply Cancel reply

Cũ vẫn chất