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

Liên hệ QC

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 ạ?
 
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
Những code này rất hay!
 
Lần chỉnh sửa cuối:
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
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!
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
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!

Đồ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
Đồ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.

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

Đú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
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!

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
Xin hỏi các chuyên gia có code nào xóa một sub trong module khô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
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

Tuyệt quá có cả dịch nghĩa nữa! Tks Thầy!
***********************************
Mã:
'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"
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom