Em tạo một macro tạo ra các sheet kết quả. Em muốn macro gắn cho các sheet này các đoạn code (code viết cho sheet). Vậy phải làm sao ạ.
Nếu như ban đầu đã có sheet kết quả rồi thì chỉ việc viết code trên sheet kết quả ấy.
Vấn đề là ban đầu chưa có sheet kết quả. Sau khi chạy macro mới ra các sheet kết quả. Em muốn macro tự động viết code cho các sheet kết quả này (các sự kiện cho sheet kết quả như click vào cell thì tô màu cell đó trên sheet kết quả chả hạn...)
Bạn xem bài #138 của tôi. Mà tốt nhất bạn nên đọc các bài trong chủ đề.
http://www.giaiphapexcel.com/forum/showthread.php?72632-Có-thể-dùng-vba-để-xóa-vba-đc-không/page14
Tôi đính kèm tập tin modVBIDE. Bạn giải nén. Hoặc bạn copy code dưới đây vào 1 module.
Tôi nghĩ là để làm việc bạn cần thì gọi hàm AddFunctionFromString và truyền vào 3 thông số: wb (là đối tượng worbook mà nơi đó bạn cần thêm code), CompName (module trong workbook wb nơi bạn muốn thêm code. vd. "Sheet1", "ThisWorkbook", "UserForm1", Module3", "clsHehe" v...v), text (nội dung code cần thêm vào module)
Tôi chú thích nhiều nên bạn sẽ hiểu mỗi function làm gì, sử dụng chúng như thế nào.
[GPECODE=vb]
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, ProcKind As Long
' On Error Resume Next
' module có phương thức cần xóa
Set VBCM = wb.VBProject.VBComponents(CompName).CodeModule
If Not VBCM Is Nothing Then
On Error GoTo errHandler
' 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, ProcKind)
If ProcStartLine > 0 Then
' tổng số dòng của phương thức
ProcLineCount = VBCM.ProcCountLines(ProcedureName, ProcKind)
' 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
errHandler:
If Err.Number = 35 And ProcKind < 3 Then
ProcKind = ProcKind + 1
Resume
End If
End Sub
Sub InsertVBComponent(ByVal wb As Workbook, ByVal CompFileName As String)
' cần có tham chiếu Microsoft Visual Basic for Applications Extensibility
' thêm module, class module, user form từ tập tin BAS, CLS, FRM có tên đầy đủ là CompFileName vào bảng tính wb
' Tập tin CompFileName phải có cấu trúc đúng nhưmột thành phần của VBA (giống nhưđược xuất từ VBA ra)
' đường dẫn không được có ký tự Việt
' InsertVBComponent Workbooks("vbe.xls"), "c:\mysecretclass.cls"
' InsertVBComponent Workbooks("vbe.xls"), "c:\sapxep.frm"
' InsertVBComponent Workbooks("vbe.xls"), "c:\modSort2DArray.bas"
Dim VBCp As VBComponents
On Error Resume Next
If Dir(CompFileName) <> "" Then ' nếu tập tin tồn tại
Set VBCp = wb.VBProject.VBComponents
' nhập thành phần vào VBA
VBCp.Import CompFileName
Set VBCp = Nothing
End If
On Error GoTo 0
End Sub
Sub DeleteVBComponent(ByVal wb 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 = wb.VBProject.VBComponents
If Not VBCp Is Nothing Then VBCp.Remove VBCp(CompName)
Set VBCp = Nothing
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Sub DeleteModuleContent(ByVal wb 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 module) của module có tên là CompName trong bảng tính wb
' vd. DeleteModuleContent Workbooks("vbe.xls"), "module3"
On Error Resume Next
With wb.VBProject.VBComponents(CompName).CodeModule
.DeleteLines 1, .CountOfLines
End With
On Error GoTo 0
End Sub
Public Function FunctionInModule(ByVal wb As Workbook, ByVal CompName As String, ByVal FuncName As String) As Boolean
' Microsoft Visual Basic for Applications Extensibility
' Nếu hàm có trong module thì FunctionInModule trả về TRUE còn không thì trả về FALSE
' Tên hàm không phân biệt chữ hoa thường
Dim currLine As Long, name As String, CM As VBIDE.CodeModule
FuncName = LCase(FuncName)
Set CM = wb.VBProject.VBComponents(CompName).CodeModule
FunctionInModule = False
With CM
currLine = .CountOfDeclarationLines + 1
Do Until currLine >= .CountOfLines
name = .ProcOfLine(currLine, vbext_pk_Proc)
If LCase(name) = FuncName Then
FunctionInModule = True
Exit Do
End If
currLine = currLine + .ProcCountLines(name, vbext_pk_Proc)
Loop
End With
Set CM = Nothing
End Function
Public Function FunctionInProject(ByVal wb As Workbook, ByVal FuncName As String) As String
' Microsoft Visual Basic for Applications Extensibility
' nếu hàm có trong Project thì hàm trả về tên của Module có chứa hàm, ngược lại trả về vbNullString
Dim VBComp As VBIDE.VBComponent
On Error Resume Next
FunctionInProject = vbNullString
For Each VBComp In wb.VBProject.VBComponents
If FunctionInModule(wb, VBComp.name, FuncName) Then
FunctionInProject = VBComp.name
Exit For
End If
Next
End Function
Public Function ComponentInProject(ByVal wb As Workbook, ByVal CompName As String) As Boolean
Dim VBComp As VBIDE.VBComponent
CompName = LCase(CompName)
On Error Resume Next
ComponentInProject = False
For Each VBComp In wb.VBProject.VBComponents
If LCase(VBComp.name) = CompName Then
ComponentInProject = True
Exit For
End If
Next VBComp
End Function
Public Function FunctionCode(ByVal wb As Workbook, ByVal CompName As String, ByVal FuncName As String) As String
Dim CM As VBIDE.CodeModule, ProcKind As Long
' trả về mã của hàm FuncName kể cả dòng trống và chú thích. Nếu FuncName không có trong module thì trả về vbNullString
'On Error Resume Next
Set CM = wb.VBProject.VBComponents(CompName).CodeModule
If Not CM Is Nothing Then
On Error GoTo errHandler
With CM
FunctionCode = .Lines(.ProcStartLine(FuncName, ProcKind), .ProcCountLines(FuncName, ProcKind))
End With
End If
Set CM = Nothing
Exit Function
errHandler:
If Err.Number = 35 And ProcKind < 3 Then
ProcKind = ProcKind + 1
Resume
End If
End Function
'hu
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, ProcKind As Long
With wb.VBProject.VBComponents(CompName).CodeModule
currLine = .CountOfDeclarationLines + 1
On Error GoTo errHandler
Do Until currLine >= .CountOfLines
ReDim Preserve Arr(0 To k)
name = .ProcOfLine(currLine, ProcKind)
Arr(k) = name
currLine = currLine + .ProcCountLines(name, ProcKind)
k = k + 1
Loop
End With
ListFunctions = Arr
Exit Function
errHandler:
If Err.Number = 35 And ProcKind < 3 Then
ProcKind = ProcKind + 1
Resume
End If
End Function
Function IsTypeToExport(ByVal VBComp As VBIDE.VBComponent) As Boolean
' tham chieu: Microsoft Visual Basic for Applications Extensibility
' IsTypeToExport trả về TRUE khi component là Class Modules, Forms, và modules.
' trả về FALSE khi component là ThisWorkbook hoặc Sheet1, 2, 3, ...
Select Case VBComp.Type
Case vbext_ct_ClassModule, vbext_ct_MSForm, vbext_ct_StdModule
IsTypeToExport = True
Case Else
IsTypeToExport = False
End Select
End Function
Function ListComponents(ByVal wb As Workbook)
' tham chieu: Microsoft Visual Basic for Applications Extensibility
Dim VBComp As VBIDE.VBComponent, Arr(), k As Long, index As Long
For Each VBComp In wb.VBProject.VBComponents
ReDim Preserve Arr(0 To k)
Arr(k) = VBComp.name
k = k + 1
Next VBComp
ListComponents = Arr
End Function
Function AddFunctionFromFile(ByVal wb As Workbook, ByVal CompName As String, ByVal filename As String) As Boolean
' thêm code của hàm, sub từ tập tin filename vào component (sheet, thisworkbook, userform, module, class module) với tên là
' CompName ("Sheet1", "ThisWorkbook", "UserForm1", Module3", "clsHehe" v...v) trong book wb
' Nếu thành công thì trả về TRUE, ngược lại trả về FALSE
On Error GoTo end_
wb.VBProject.VBComponents(CompName).CodeModule.AddFromFile filename
AddFunctionFromFile = True
end_:
End Function
Function AddFunctionFromString(ByVal wb As Workbook, ByVal CompName As String, ByVal text As String) As Boolean
' thêm code của hàm, sub từ String text vào component (sheet, thisworkbook, userform, module, class module) với tên là
' CompName ("Sheet1", "ThisWorkbook", "UserForm1", Module3", "clsHehe" v...v) trong book wb
' Nếu thành công thì trả về TRUE, ngược lại trả về FALSE
On Error GoTo end_
wb.VBProject.VBComponents(CompName).CodeModule.AddFromString text
AddFunctionFromString = True
end_:
End Function
Function GetComponentExtenstion(VBComp As VBIDE.VBComponent) As String
Select Case VBComp.Type
Case vbext_ct_ClassModule, vbext_ct_Document, 100
GetComponentExtenstion = ".cls"
Case vbext_ct_MSForm
GetComponentExtenstion = ".frm"
Case vbext_ct_StdModule
GetComponentExtenstion = ".bas"
Case Else
GetComponentExtenstion = vbNullString
End Select
End Function
Function ExportComponentToFile(ByVal wb As Workbook, ByVal CompName As String, ByVal SaveDir As String) As Boolean
' xuất ra tập tin filename component (sheet, thisworkbook, userform, module, class module) với tên là
' CompName ("Sheet1", "ThisWorkbook", "UserForm1", Module3", "clsHehe" v...v) trong book wb
' Nếu thành công thì trả về TRUE, ngược lại trả về FALSE
Dim ext As String, VBComp As VBIDE.VBComponent
On Error GoTo end_
Set VBComp = wb.VBProject.VBComponents(CompName)
If VBComp Is Nothing Then Exit Function
ext = GetComponentExtenstion(VBComp)
If ext <> vbNullString Then
VBComp.Export SaveDir & "\" & CompName & ext
ExportComponentToFile = True
End If
end_:
End Function
[/GPECODE]
