Cái file setup đó là tui tham khảo từ trên mạng và cũng chưa hiểu rõ được nhiều lệnh trong đó nên bảo hướng dẫn thì thua thật, còn bạn muốn chia sẻ code thì mình đã chia sẽ rồi, cụ thể có rất nhiều bác xem code và chê khen đủ thứ rồi còn gì? đa số các code của tôi trên diễn đàn có đầy, nếu bạn cần thì để lại email tôi sẻ chia sẻ riêng cho bạn.
Mình cũng ko cần cao siêu gì cả cứ làm đc bộ setup như bạn là ok rồi, mình mới nghiên cứu về VBA do nhu cầu công việc, email của mình là btnamncseif@gmail.com mong bạn share code vntool và cái hướng dẫn nho nhỏ để mình có thể làm đc cái bộ setup (nếu share luôn thư viện code mà bạn siêu tập được thì ok quá ^^). Thx in advanced!
Sau 2 ngày Nghiên cứu Code Add-Ins mã hóa Bạn úp ....Mạnh mới chỉnh sửa và viết lại thành 1 File setup = VB6 Bạn tải về Test thử nha ....Viết Add-ins trên VB6 quá đơn giản mà ....Bảo mật code OK
Bạn thử khỏi động lại máy xem ... Và File mã hóa Phải là Office 2003 đuôi File *.xls ... sau khi mã hóa xong thì chuyển sang Version Office nào thì chuyển
Hay! bác Mạnh có thể chia sẻ source code vb6 cho mình tham khảo được không vậy? Còn một cái nửa là có cách nào tạo Menu Excel trong VB6 luôn và không cần đến file xla không? tôi thấy cái GirdHightLighter của anh Duy Tuân đã làm như vậy (Để vào IDE không thấy file xla).
Bạn chạy OK không vây ....
Bác rảnh chia sẻ code tui với nha ^^ #22
Mình chưa làm được nên mới nhờ bạn chia sẻ, nếu bất tiện thì thôi vậy. Cho mình hỏi thêm một vấn đề nửa là bạn tạo thư viện DLL và sử dụng lệnh.
With CreateObject("EncryptVBAProject.VBAProject")
Set .ExcelApp = Application
.EncryptVBAProject
Set .ExcelApp = Nothing
End With Dim ObjP As VnToolsExcel.Proc
Set ObjP = New VnToolsExcel.Proc
Set ObjP.ExcelApp = Application
ObjP.ConvFont Selection, "VNI", False
Set ObjP = NothingPublic DLL As Object
Public Sub Auto_Open()
Set DLL = CreateObject("TenDLL.TenClass")
Set DLL.ExcelApp = Application
End Sub
Public Sub Auto_Close()
Set DLL = Nothing
End Sub
Public Sub Main()
Path = ThisWorkbook.Path
DataRange = "A6:J100"
DLL.TenHam Path, DataRange, [A65536]
End SubSub Main()
FilePath = "C:\Windows\System32\xx.dll"
With New TenDLL.TenClass
.TenHam (FilePath)
End With
End SubPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Nếu có cách sử dụng hàm API sử dụng cho bản 32bit và 64bit ngắn thì ngon quá, cái tiện ích mã hóa này thật sự khi mình sử dụng mới thấy có nhiều cái chưa được lắm, nếu bác KieuManh có nghiên cứu thì hoàn chỉnh cho anh em sử dụng luôn. Một cách suy nghĩ nửa nhưng khả năng không làm được, không biết bác KieuManh có nghiên cứu thì nghiên cứu tiếp luôn(nếu có hứng thú), đó là mã hóa xong thì tạo ra luôn file txt để chứa mã đã mã hóa, sau có cần thì dùng cái file txt chứa mã đó để dịch ngược(phải viết ra cái tiện ích dùng để dịch mã) lại code có được không?Lục lại Hồ sơ Mạnh thấy thay vì Xài Hàm API sau ...
Mã:Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
1/ Thì ta xài Cách khác vậy ....chỉ 1 dòng code là có thể xài cho Win64 hay 32 bít ... và Bạn Mã hóa vô Tư không lo lỗi ... Cũng Run As được vậy ....
2/ Nếu xài Hàm trên muốn xài cho Win64 và 32 thì viết quá dài dòng và hay Lỗi ... Mục đích là cũng Run As mà thôi ....Vậy ý bạn sao ta nghiên cứu tiếp ....
3/ Mình có tham khảo Cách Run As cmd ở rất nhiều diễn đàn ....
Thấy họ chỉ xài API không thôi ...còn cách khác chưa thấy ...
Nhưng trên GPE đã có người viết code ko xài API mà vẫn Run As được ...code đang có trên GPE và Mã hóa OK ...
Public Const uvwxyzabbbcbdb = 271, w = 203, ii = 72, oo = "E", pp = 0, aa = "6", ss = 7897, hh = 7921, jj = 10, kk = 227, ooo = "H", ppp = 7, uuu = "1", yyy = "7", rrr = True, ii_i_l_i_l_i_l = 7909, l_i_l_i_l_i_l_l_l_i_l_l_l = 7917, l_i_i_i_l_l_i_i_l_i_i_l_i = 7875, l_l_i_i_i_l_l_l_i_l_l_i_i = 253, l_l_l_i_l_l_l_i_l_l_i_i_l_l = 259, l_i_i_ii_i_l_l_l = 242, l_i_i_i_i_i_i_l_i_i_i = "V", xxx = "", ttt = "A", l_l_i_l_i_i_l_i = 7853, l_i_i_i_i_i_i_i_l_i_i_l_i_i = 7845, l_l_i_l_l_i_l_l_l_i_i_i_l = 236, vvv = "K", qqq = "x", ee = """", _
kim_l = "/", k = 1, xx = "R", sss = 6, ggg = False, hhh = "?", kim_i = "k", jjj = 7901, kkk = 226, lll = 7889, zzz = 243, l_i_i_l_l_l = "'", l_l_i_i_l_l_i_l_l_i_i_i_l_l = 7879, v = "v", l_i_i_i_l_l_l_i_i_i_l_i_l_l = "f", l_l_l_i_l_l_i_l_l_i_i_l_i = 7863, l_i_l_i_l_i = 273, l_i_i_l_i_l_l_i_l_l_l_i_l = 224, c = 432, l_l_i_l_i_l_l_l_i_i_l = 7841, l_i_l_i_i_l_i_i_i_i_i_i_l_i = "B", ccc = 225, yy = " ", iii = 244, eee = "h", mm = "2", nn = "3", z = "w", bb = "W", rr = "\", vv = ":", _
dd = "j", sh3 = "b", ff = "O", gg = "m", ww = "y", m = "F", n = "g", b = "n", l = "t", d = "p", sh2 = "i", s = "r", a = "c", p = "S", ll = "e", www = "u", zz = "d", qq = "o", cc = "M", x = "s", uu = "a", j = "C", xy = ".", g = "D", f = "T", sh1 = "L", h = "_", tt = "l", l_l_l_i_i_l_l_i_i_i_i_i = "I"
'Open Run File Bat
Public Sub ebfbgbhbibjbkblbmbnb()
Dim obpbqbrbsbtbubvbwbxb
obpbqbrbsbtbubvbwbxb = ThisWorkbook.Path & rr & xx & ll & n & g & sh1 & sh1 & xy & sh3 & uu & l
'sPath = ThisWorkbook.Path & "\REGDLL.BAT"
CreateObject(p & eee & ll & tt & tt & xy & ttt & d & d & tt & sh2 & a & uu & l & sh2 & qq & b).shellexecute obpbqbrbsbtbubvbwbxb, xxx, xxx, s & www & b & uu & x, k
End SubCreateObject("Shell.Application").ShellExecute "cmd.exe", 0, 0, "Runas", TruePublic Function OpenFileRunAs(ByVal strPath As String) As Boolean
CreateObject("Shell.Application").ShellExecute strPath, "", "", "Runas", True
End Function
Public Sub Main_RunAdmin()
Dim sPath As String
sPath = ThisWorkbook.Path & "\REGDLL.BAT"
OpenFileRunAs (sPath)
End SubPublic Function RegisterRunAs(ByVal sPath As String) As Boolean
CreateObject("Shell.Application").ShellExecute "cmd.exe", "/c Regsvr32 /s " & sPath, 0, "Runas", True
End Function
Public Sub Main_RegisterRunAs()
Dim sPath As String
sPath = "C:\Windows\System32\EncryptVBA.dll"
RegisterRunAs (sPath)
End Sub
Xin lỗi anh cho em hỏi khi sử dụng Public Sub trong DLL thì nó có hiện ra cái bảng để chọn các sub. Còn khi sử dụng Public Function thì nó không hiện nhưng khi đánh lệnh trong vba thì nó vẫn chạy.
thì bạn muốn nó chạy thì nó chạy ...còn ko thì nó ko chạyXin lỗi anh cho em hỏi khi sử dụng Public Sub trong DLL thì nó có hiện ra cái bảng để chọn các sub. Còn khi sử dụng Public Function thì nó không hiện nhưng khi đánh lệnh trong vba thì nó vẫn chạy.
bạn up code VB6 lên cho mình dòm 1 cái được không
Vang day anh, em copy code cua anh Nguyen Duy Tuan va Code trong lập trình DLL.
Option Explicit 'Yêu c?u toàn b? bi?n ph?i khai báo
'************************************************* ************
'Khai báo bi?n Class (l?p) ? du?i
'************************************************* ************
'Ð?i tu?ng tham chi?u s? g?i ?ng d?ng Excel
Private mxlApp As Excel.Application 'oApp As Excel.Application
'
Public WithEvents WB As Excel.Workbook
'local variable(s) to hold property value(s)
Private mvarVung_bi_khoa As Excel.Range 'local copy
'************************************************* ************
'Ð?t thu?c tính c?a Class
'************************************************* ************
Public Property Set ExcelApp(ByRef xlApp As Excel.Application)
Set mxlApp = xlApp
End Property
Public Property Set Vung_bi_khoa(ByVal vData As Excel.Range)
Set mvarVung_bi_khoa = vData
End Property
Public Property Get Vung_bi_khoa() As Excel.Range
Set Vung_bi_khoa = mvarVung_bi_khoa
End Property
Private Sub Destroy()
Set WB = Nothing
Set mxlApp = Nothing
MsgBox "Hen gap lai cac ban trong de tai khac", vbInformation, "Tac gia: Nguyen Duy Tuan - EMail: TuanKTCDCN@yahoo.com"
End Sub
'************************************************* ************
'T?o s? ki?n c?a Class sau khi k?t thúc công vi?c
'************************************************* ************
Private Sub Class_Terminate()
'Destroy
Set WB = Nothing
Set mxlApp = Nothing
End Sub
' Chay Dll tren Worb dang mo
Public Sub Create(ByRef ExcelApplication As Excel.Application, ByVal WorkbookName As Variant)
If mxlApp Is Nothing Then
Set mxlApp = New Excel.Application
Set mxlApp = ExcelApplication
End If
If Not mxlApp Is Nothing And WorkbookName <> "" Then
Set WB = mxlApp.Workbooks(WorkbookName)
End If
If WB Is Nothing Then MsgBox "Khong the ket noi duoc voi DLL", vbCritical, "Loi tao DLL"
End Sub
'
Public Function TachHoTen(ByVal HoVaTen As String, Optional TachTen As Boolean = True) As String
Dim Pos_Right As Integer
If HoVaTen = "" Then GoTo EndFunc
HoVaTen = Trim(HoVaTen) 'Xoá khoa?ng tro^'ng hai bên cu?a "HoVaTen"
Pos_Right = InStrRev(HoVaTen, " ")
'Kie^?m tra ho+.p le^.
If Pos_Right = 0 Or Pos_Right - 1 < 0 Or Pos_Right + 1 > Len(HoVaTen) Then
GoTo EndFunc:
End If
If TachTen Then
TachHoTen = Mid(HoVaTen, Pos_Right + 1)
Else
TachHoTen = Left(HoVaTen, Pos_Right - 1)
End If
EndFunc:
End Function
'************************************************* ************
'Các phuong th?c trong Class ho?t d?ng
'************************************************* ************
Public Sub ShowMessageExcel()
MsgBox "Hello World!", vbInformation
End Sub
Public Sub WriteMessageExcel()
mxlApp.ActiveCell.Value = "Hello World!"
End Sub
