Suggestions | Adapt VBA in a VBAProject using VBA |
1 Workbook and VBProject 2 Modules 3 Macromodule 3.1 Macro 3.2 Function 4 Workbook 5 Worksheet 6 ActiveX control 7 Userform |
Adapt VBA in a workbook using VBA VBA can create and maintain macros, functions, userforms, ActiveX controls and userformcontrols.In the course of running a macro you can create, adapt, copy or delete macros, functions or userforms. In this page we take VBA in Excel as an example. So we are describing VBA in a workbook. All green marked text is meant as example; you can adapt it to your own situation. Before applying code it's best to load the referenc to the VBA extensiblility library: - manually : open the VBE Editor: Alt-F11/Menu Bar/ Extra / references/ check 'Microsoft Visual Basic for Application Extensibility 5.3' - using VBA Method 'AddFromGuid' Sub load_reference_1() ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
end subSub Load_reference_2() ThisWorkbook.VBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
end subIf you want to refer to the workbook that contains the code that is running you should use the VBA object: ThisWorkbook. An Excel workbook can contain VBA code; in the VBA language: the VBproject. ThisWorkbook.VBproject VBA code is always part of a 'module' in an Excel file. An Excel file has 5 kinds of modules (in VBA language: VBComponents): o ThisWorkbook: the file o Sheet: a worksheet or a chartsheet o Macromodule: a module that can only contain macros and/or functions o Userform: a userinterface that can contain macros, functions and controls o Classmodule: a module that can only contain macros and/or functions; meant to be called from other modules ThisWorkbook.VBProject.VBComponents A Workbook contains 1 codemodule maximally 'ThisWorkbook'. All other modules can be added ad libitum. All modules can contain VBA-code. VBA has different kinds of code: - declarations - macros (starting/ending with 'Sub ...End Sub' - functions (starting/ending with 'Function ... End Function' - events: thisWorkbok has certain builtin events, like every sheet has - ActiveX controls and their events - Userformcontrols and their events Not every module can contain all those different kinds of code: ThisWorkbook: - macros - functions - events Worksheet - macros - functions - events - ActiveX controls and ActiveX-events Macromodule - macros - functions Userform - macros - functions - events - formcontrols and formcontrol events Classmodule - macros - functions - events In VBA you can refer to a module using it's name or it's indexnumber. The indexnumber of ThisWorkbook is always 1, the indexnumber of the first worksheet is 2. ThisWorkbook.VBProject.VBComponents(1) ThisWorkbook.VBProject.VBComponents("ThisWorkbook") 2.2 An inventory of all modulenames All modules have a 'VBA-name': in VBA language 'codename'.Using that name you can refer to that module directly. The workbook and the worksheets also have a 'common' name: the workbook: the filename, the worksheet: the name on it's tabstrip The modules of a VBproject constitute the collection 'VBComponents'. Sub Modules_namen() For j= 1 to ThisWorkbook.VbProject.VBComponents.Count
End Submsgbox ThisWorkbook.VBProject.VBComponents(j).Name
NextSub Modules_namen2() For each cp in ThisWorkbook.VbProject.VBcomponents
End Submsgbox cp.Name
NextSub Module_workbook_codenaam() msgbox=ThisWorkbook.CodeName
End SubSub module_worksheet_codenamen() For each sh in ThisWorkbook.Sheets
End Submsgbox sh.CodeName
NextThis is a readonly property, you can't use it to change it's VBA-name. Therefore we need: Sub modulenaam_workbook_wijzigen() ThisWorkbook.VbProject.VBcomponents("ThisWorkbook").Name ="hoofdbestand"
End SubAlso in this case we need another method. Sub Modulenaam_worksheet_wijzigen() ThisWorkbook.VbProject.VBcomponents(2).Name ="worksheet overzicht"
End SubSub Modulenaam_userform_wijzigen() ThisWorkbook.VbProject.VBcomponents("Userform1").Name ="invoer"
End SubSub Modulenaam_macromodule_wijzigen() ThisWorkbook.VbProject.VBcomponents("Module1").Name ="macroos"
End SubSub Modulenaam_classmodule_wijzigen() ThisWorkbook.VbProject.VBcomponents("Klasse1").Name ="Klas_I"
End Sub- a worksheet - a macromodule (vbext_ct_StdModule) - a Userform (vbext_ct_MSForm) - a classmodule (vbext_ct_ClassModule) Sub Worksheetmodule_toevoegen() ThisWorkbook.Sheets.Add
End SubSub Macromodule_add1() ThisWorkbook.VBProject.VBComponents.Add vbext_ct_StdModule
End SubSub Macromodule_add2() ThisWorkbook.VBProject.VBComponents.Add 1
End SubIf you prefer custom names: Macromodule: add with custom name Sub Macromodule_toevoegen_naam1() ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name ="Macroos"
End SubSub Macromodule_toevoegen_naam2() ThisWorkbook.VBProject.VBComponents.Add(1).Name ="Macroos"
End SubSub Userform_toevoegen1() ThisWorkbook.VBProject.VBComponents.Add vbext_ct_MSForm
End SubSub Userform_toevoegen2() ThisWorkbook.VBProject.VBComponents.Add 3
End SubIf you prefer a custom name: Userform: add with custom name Sub Userform_toevoegen_naam1() ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name="invoer"
End SubSub Userform_toevoegen_naam2() ThisWorkbook.VBProject.VBComponents.Add(3).Name ="invoer"
End SubSub Classmodule_toevoegen1() ThisWorkbook.VBProject.VBComponents.Add vbext_ct_ClassModule
End SubSub Classmodule_toevoegen2() ThisWorkbook.VBProject.VBComponents.Add 2
End SubIf you prefer a custom name: Classmodule add with custom name Sub Classmodule_toevoegen_naam1() With ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name="Klassenaam"
End SubSub Classmodule_toevoegen_naam2() ThisWorkbook.VBProject.VBComponents.Add(2).Name ="Klassenaam"
End SubExtensions: - .bas is a macromodule - .frm is a userform - .cls is a workbook, worksheet or classmodule These exported modules ca easily be distributed and being imported in different Excel files. Sub Macromodule_export() With ThisWorkbook.VBProject.VBComponents("Macroos")
End Sub.export"E:\OF\"&.Name & ".bas"
End WithSub Userform_export() With ThisWorkbook.VBProject.VBComponents("invoer")
End Sub.export"E:\OF\"&.Name & ".frm"
End WithSub Worksheet_export() With ThisWorkbook.VBProject.VBComponents("Sheet1")
End Sub.export"E:\OF\"& .Name & ".cls"
End WithSub Classmodule_export() With ThisWorkbook.VBProject.VBComponents("Klasse1")
End Sub.export"E:\OF\"& .Name & ".cls"
End WithSub Workbook_export() with ThisWorkbook.VBProject.VBComponents(1)
End Sub.export"E:\OF\"&.Name & ".cls"
End With- Workbook (Type = 100) - Worksheet, classmodule (Type = 2) - Userform (Type = 3) - Macromodule (Type = 1). Sub Alle_modules_export() For Each cp In ThisWorkbook.VBProject.VBComponents
End Subcp.Export"E:\OF\"& cp.Name & Switch(cp.Type = 1, ".bas", cp.Type = 3, ".frm", cp.Type = 2, ".cls", cp.Type = 100, ".cls")
NextSub Worksheet_import() ThisWorkbook.VBProject.VBComponents.Import "E:\OF\sheet1.cls"
End SubSub Macromodule_import() ThisWorkbook.VBProject.VBComponents.Import "E:\OF\Macroos.bas"
End SubSub Userform_import() ThisWorkbook.VBProject.VBComponents.Import "E:\OF\invoer.frm"
End SubSub Classmodule_import() ThisWorkbook.VBProject.VBComponents.Import "E:\OF\klasse5.cls"
End SubSince a workbook can only contain 1 workbookmodule the import could seem to be problematic. VBA adds the imported file automatically as a classmodule to the collection VBComponents. Sub worksheet_delete() ThisWorkbook.Sheets(1).Delete
End SubSub Macromodule_delete() With ThisWorkbook.VBProject
End Sub.VBComponents.Remove .VBComponents("Macroos")
End WithSub Userform_delete() With ThisWorkbook.VBProject
End Sub.VBComponents.Remove .VBComponents("invoer")
End WithSub Classmodule_delete() With ThisWorkbook.VBProject
End Sub.VBComponents.Remove .VBComponents("Klasse1")
End WithSub Modules_delete() With ThisWorkbook.VBProject
End Subfor each cp in .VBComponents
End With.VBcomponents.Remove cp
Next2.8 Module: copy to another Excelfile Sub worksheet_copy() Thisworkbook.sheets(1).copy workbooks(2).sheets1
End subMethod 1 · Export the module to a '.bas' (macromodule) or '.frm' (userform) file, it's name idential to the module name · Open a new Excel file; import the '.bas' (resp. the '.frm')-file. Sub Macromodule_copy1() ThisWorkbook.VBProject.VBComponents("Macroos").export "E:\Macroos.bas"
End SubWith Workbooks.Add .VBProject.VBComponents.import "E:\Macroos.bas"
End With1. Read the module's name and it's code. 2. Open a new Excel file; add a new module, it's name identicel to the module to copy. 3. Put the code of the original module into the new module (I'll discuss the methode - AddFromString- later) Sub Macromodule_copy2() With ThisWorkbook.VBProject.VBComponents("Macroos")
End Subc00 = .Name
End Withc01 = .CodeModule.Lines(1, .CodeModule.CountOfLines) With Workbooks.Add With .VBProject.VBComponents.Add(vbext_ct_StdModule)
End With.Name = c00
End With.CodeModule.AddFromString c01 Sub Userform_copy1() ThisWorkbook.VBProject.VBComponents("invoer").export "E:\ invoer.frm"
End SubWith Workbooks.Add .VBProject.VBComponents.import "E:\invoer.frm"
End WithSub Classmodule_copy1() ThisWorkbook.VBProject.VBComponents("Klasse1").export "E:\Klasse_I.cls"
End SubWith Workbooks.Add .VBProject.VBComponents.import "E:\Klasse_I.cls"
End WithSub Classmodule_copy2() With ThisWorkbook.VBProject.VBComponents("Klasse1")
End Subc00 = .Name
End Withc01 = .CodeModule.Lines(1, .CodeModule.CountOfLines) With Workbooks.Add With .VBProject.VBComponents.Add(vbext_ct_ClsModule)
End With.Name = c00
End With.CodeModule.AddFromString c01 2.8.5 All macromodules and userforms: copy Sub Modules_copy() for each cp in ThisWorkbook.VBProject.VBComponents
End Subif cp.type<>100 then
Nextif Workbooks.count=1 then workbooks.Add
End ifWith workbooks(2).VBProject.VBComponents.Add(vbext_ct_MSForm) .Name = cp.name
End with.CodeModule.AddFromString cp.codemodule.lines(1,cp.codemodule.countofLines) 2.9 Modules: move to another file In the VBEditor' project subscreen you can drag modules (worksheets, macromodules, userforms and classmodules) form one file to another.The 'receiving' file gets a copy of the dragged module. So far I couldn't find a VBA equivalent for this. VBA only has a method to move worksheets within a file or between files. 2.9.1 Worksheet: move within a workbook Sub verplaats_worksheet() ThisWorkbook.Sheets(1).Move ThisWorkbook.Sheets(4)
End Sub2.9.2 Worksheet: move to another file Sub verplaats_worksheet_naar_ander_workbook() ThisWorkbook.Sheets(1).Move Workbook(2).Sheets(4)
End Sub2.9.3 Userform: move to another file Use the export-import methode to accomplish this2.9.4 Macromodule: move to another file Use the export-import method to accomplish this2.9.5 Classmodule: move to another file Use the export-import method to accomplish this A module (workbook, worksheet, userform, macromodule, classmodule) has a property 'codemodule' that contains all it's VBA code.This codemodule contains all VBA procedures: macros, events, functions. There are 5 kinds of procedures: 1. Module events The workbook, each worksheet, each classmodule and each userform has module specific events. For example: - the opening of a workbook (Private Sub Workbook_Open) - the changing of a worksheet (Private Sub Worksheet_Change) - the initialising of a userform (Private Sub Userform_Initialize) - the initialising of a classmodule (Private Class_initialize() These events refer to the module (workbook, worksheet, userform) itself. The VBA code for these events is in the codemodule of the workbook, worksheet, userform, classmodule respectively. 2. Macros All modules (workbook, worksheet, userform, macromodule, classmodule) can contain macros. 3. Function All modules (workbook, worksheet, userform, macromodule, classmodule) can contain functions. 4. ActiveX controls Only worksheets can contain ActiveX controls and ActiveX-eventprocedures. ActiveX controls derive from the set ActiveX controls (e.g. textbox, optionbutton, checkbox, listbox, combobox, commandbutton, label, etc). Don't confuse them with formcontrols in a worksheet. 5. Formcontrols Only Userforms can contain userformcontrols and userformcontrol eventprocedures. For instance textbox, optionbutton, checkbox, listbox, combobox, commandbutton, label, etc. They originate from a collection formcontrols in a separate library.
Procedures A procedure (macro, event or function) isn't a separate object. That's why VBA doens't provide a methode to add, to copy, to rename/move or to delete/remove). A procedure (macro, event or function) is nothing more than a set of lines in the codemodule. The beginning and the end of a procedure are marked by a startline and an endline: Macros and events: Sub name (arguments) End Sub Function name (arguments) End Function The codemodule can be considered to be 1 page of text. The basic unit in this page is a line. The startlines and the endlines of a procedure mark the procedures in the page. The scope of eventprocedures is restricted to a module. So an eventprocedure always has as scope indicator 'Private': Private Sub Workbook_Open() Codemodule Eventprocedures can only contain builtin arguments: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Writing in a codemodule You can add VBA code using the method AddFromString, InsertLines or AddFromFile. VBA has a distinct method to add an eventprocedure : CreateEventProc. This method CreateEventProc adds the startline and endline automatically: Private Sub ***_methode(ByVal ...) End Sub 3.1.1 Read the complete VBA code Sub Code_in_workbookmodule_lezen() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End SubMsgBox .Lines(1, .CountOfLines)
End With3.1.2 Read a part of the VBA-code ' all lines except the last 20 lines ' all lines except the first 10 lines ' line 15 to line 45 ' all declarationlines Sub Code_in workbook_deels_lezen() With ThisWorkbook.VBProject.VBComponents(2).CodeModule
End Subc00 = .Lines(1, .CountOfLines-20)
End Withc01 =.Lines(10,.CountOflines-10) c02 =.Lines(15,30) c03 =.Lines(1,.CountOfDeclarationLines) 3.1.3 Delete all code from a codemodule Sub Code_workbookmodule_delete() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End Sub.DeleteLines 1, .CountOfLines
End With3.2.1.1 Read all macros in a module VBA has no method to show all VBA procedures in a module.We construct that method ourselves: every line in a module has the property 'ProcOfLine' that returns the name of the procedure (macro, function) it is part in. If we constitute a list of unique names based on that property the result will be a list of all macros. We can put that list in a combobox in a userform. Sub Macros_van_macromodule_in_userform_combobox()
For j = 1 To ThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.CountOfLines
End Subc02 = ThisWorkbook.VBProject.VBComponents(1).CodeModule.ProcOfLine(j, 0)
NextIf InStr(c01, c02) = 0 Then c01 = c01 & "|" & c02 keus1.List = Split(Mid(c01, 2), "|") Sub Macro_zoeken()
MsgBox "macro3" & IIf(ActiveWorkbook.VBProject.VBComponents("Macroos").CodeModule.Find("Sub macro3(", 1, 1, -1, -1), "", "Not") & "found."
End Sub- AddFromString - InsertLines - AddFromFile - Method AddFromString: the textstring containing VBA code will always be added to the beginning of a codemodule. Sub Macro_in_macromodule_maken() c00 =replace(Replace(Replace("Sub nieuwe_macro()#*MsgBox ^QED ^#End Sub", "#", vbCr), "*", vbTab),"^",chr(34))
End SubThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.AddFromString c00 * A macroname can't contain spaces. * In the example a string is being made, before adding it to the codemodule. * To avoid &'s in the code I used 'replace'. "Sub nieuwe_macro()" & vbCr & vbTab &"MsgBox " & Chr(34) & "QED" & Chr(34) & vbCr & "End Sub" - Method Insertlines You can indicate where the starting line of the new code has to begin. So, using insertlines you can specify whether the code has to be added at the beginning, at the end or somewhere between the existing lines. Therefore it can be necessary to check whether the new lines won't interfere with existing ones in the codemodule. at the beginning of the macromodule Sub Macro_in_macromodule_maken2() c00 =replace(Replace(Replace("Sub nieuwe_macro()#*MsgBox ^QED ^#End Sub", "#", vbCr), "*", vbTab),"^",chr(34))
End SubThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.Insertlines 1, c00 Sub Macro_in_macromodule_maken2() c00 =replace(Replace(Replace("Sub nieuwe_macro()#*MsgBox ^QED ^#End Sub", "#", vbCr), "*", vbTab),"^",chr(34))
End SubThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.Insertlines ThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.countoflines, c00 You can import all VBA code form an ASCII file integrally. With this method it's not possible to import a part lf the file. Sub Macro_in_macromodule_maken3() ThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.Addfromfile "E:\OF\macro1.txt"
End Sub- ProcStartLine: the first line of a specified macro and - ProcCountLines: the number of codelines of a specified macro Sub Macro_read_code()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Subc00 = .Lines(.ProcStartLine("macro3", 0), .ProcCountLines("macro3", 0))
End WithSub Macro_copy()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Subc00 = .Lines(.ProcStartLine("macro3", 0), .ProcCountLines("macro3", 0))
End WithThisWorkbook.VBProject.VBComponents("Macromodule_2").AddFromString c00 Sub Macro_code_vervangen()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Sub.DeleteLines .ProcStartLine("macro3", 0) + 1, .ProcCountLines("macro3", 0) - 2
End With.InsertLines .ProcStartLine("macro3", 0) + 1, "c00 = " & Chr(34) & "Dit is de nieuwste tekst" Sub Macro_hernoemen()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Sub.ReplaceLine .ProcStartLine("macro3", 0), Replace(.Lines(.ProcStartLine("macro3", 0), 1), "macro3", "Macro37a")
End WithSub Macro_delete()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Sub.DeleteLines .ProcStartLine("macro3", 0), .ProcCountLines("macro3", 0)
End With3.2.1.9 Macro: move to another module Sub Macro_verplaatsen()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Subc00 = .Lines(.ProcStartLine("macro3", 0), .ProcCountLines("macro3", 0))
End With.DeleteLines .ProcStartLine("macro3", 0), .ProcCountLines("macro3", 0) ThisWorkbook.VBProject.VBComponents("Macromodule_2").AddFromString c00 3.2.2.1 All functions in a module The startline of every function contains the word 'Function'; after filtering all those lines the functionname s will befiltered.The list of functions will be put into an ActiveX listbox ('keus1') in worksheet 'Sheet1'. Sub Alle_functions_in_macromodule() c00 = "Function "
End SubWith ThisWorkbook.VBProject.VBComponents("Macroos").CodeModule c01=.Lines(1, .CountOfLines) c00, ""),"Private ",""), "|")Sheet1.keus1.List = Split(Replace(Replace(Join(Filter(Split(Join(Filter(Filter(Split(c01, vbCr & Chr(10)), c0), "=", False), "("), "("), c0), "|"), End With Sub Function_zoeken() MsgBox "function2" & iif(With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule.Find("function2","","not ") & "found"
End SubSub Function_maken1() c00 =replace(Replace(Replace("Function function1()#*MsgBox ^QED ^#End Sub", "#", vbCr), "*", vbTab),"^",chr(34))
End SubThisWorkbook.VBProject.VBComponents(1).CodeModule.AddFromString c00 Sub Function_maken2() c00 =replace(Replace(Replace("Function function1()#*MsgBox ^QED ^#End Sub", "#", vbCr), "*", vbTab),"^",chr(34))
End SubThisWorkbook.VBProject.VBComponents("Macroos").CodeModule.Insertlines 1, c00 Sub Function_maken3() ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.Addfromfile "E:\OF\function.txt"
End Sub3.2.2.4 Function: read the code Sub Function_code_lezen() With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Subc00 = .Lines(.ProcStartLine("function2", 0), .ProcCountLines("function2", 0))
End WithSub Function_copy()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Subc00 = .Lines(.ProcStartLine("function2", 0), .ProcCountLines("function2", 0))
End WithThisWorkbook.VBProject.VBComponents("Macroos_2").CodeModule.AddFromString c00 3.2.2.6 Function: replace code Sub Function_code_vervangen() With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Sub.DeleteLines .ProcStartLine("function2", 0) + 1, .ProcCountLines("function2", 0) - 2
End With.InsertLines .ProcStartLine("function2", 0) + 1,"c00 = " & Chr(34) & "Dit is de nieuwste tekst" Sub Function_hernoemen()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Sub.ReplaceLine .ProcStartLine("function2", 0), Replace(.Lines(.ProcStartLine("function2", 0), 1), "function2", "Function27a")
End WithSub Function_delete()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Sub.DeleteLines .ProcStartLine("function2", 0), .ProcCountLines("function2", 0)
End WithSub Function_verplaatsen()
With ThisWorkbook.VBProject.VBComponents("Macroos").codemodule
End Subc00 = .Lines(.ProcStartLine("function2", 0), .ProcCountLines("function2", 0))
End With.DeleteLines .ProcStartLine("function2", 0), .ProcCountLines("function2", 0) ThisWorkbook.VBProject.VBComponents("Macroos_2").AddFromString c00
3.3.3.1 All eventprocedures in a workbook The startline of each eventprocedure in a workbook contains the string 'Private Sub Workbook_'.We can filter all lines in the codemodule that contain that string. Sub alle_eventprocedures_in_workbook() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
end subMsgBox join(filter( split(.Lines(1, .CountOfLines),vbCrLf),"Private Sub Workbook_"),vbLf)
end withSub Workbook_eventprocedure_zoeken() msgbox "Workbook_Open" & iif(ThisWorkbook.VBProject.VBComponents(1).CodeModule.Find("Sub Workbook_Open", 1, 1, -1, -1),"", "not ") & "found"
End SubSub Workbook_eventprocedure_code_lezen() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End Subc01= .Lines(.ProcStartLine("Workbook_Open",0),.ProcCountlines("Workbook_Open",0))
End With3.3.3.4 Eventprocedure: delete Sub Workbook_eventprocedure_delete() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End Sub.DeleteLines .ProcStartLine("Workbook_Open",0),.ProcCountlines("Workbook_Open",0)
End WithSub Workbook_eventprocedure_toevoegen() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End Sub.InsertLines .CreateEventProc("Open", "Workbook") + 1, vbTab & "MsgBox " & Chr(34) & "This is a new workbook"
End WithSub Workbook_eventprocedure_copy() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End Subc01= .Lines(.ProcStartLine("Workbook_Open",0),.ProcCountlines("Workbook_Open",0))
End WithWith Workbooks(2).VBProject.VBComponents(1).CodeModule .AddFromString c01
End WithSub Workbook_eventprocedure_verplaatsen() With ThisWorkbook.VBProject.VBComponents(1).CodeModule
End Subc01= .Lines(.ProcStartLine("Workbook_Open",0),.ProcCountlines("Workbook_Open",0)
End With
With Workbooks(2).VBProject.VBComponents(1).CodeModule) .deletelines .ProcStartLine("Workbook_Open",0),.ProcCountlines("Workbook_Open",0) .AddFromString c01
End With
3.4.3.1 All eventprocedures in a worksheet The startline of every eventprocedure in a worksheet contains the string 'Private Sub Worksheet_'Sub Worksheet_alle_eventprocedures() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
end subMsgBox join(filter( split(.Lines(1, .CountOfLines),vbCrLf),"Private Sub Worksheet_"),vbLf)
end withSub Worksheet_eventprocedure_zoeken() msgbox "Worksheet_Change " & iif(ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.Find(" Sub Worksheet_Change", 1, 1, -1, -1),"", "not ") & "found"
End SubSub Worksheet_eventprocedure_code_lezen() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Subc01= .Lines(.ProcStartLine("Worksheet_Change",0),.ProcCountlines("Worksheet_Change",0))
End With3.4.3.4 Eventprocedure: delete Sub Worksheet_eventprocedure_delete() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Sub.DeleteLines .ProcStartLine("Worksheet_Change",0),.ProcCountlines("Worksheet_Change",0)
End WithSub Worksheet_eventprocedure_toevoegen() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Sub.InsertLines .CreateEventProc("Change", "Worksheet") + 1,vbTab & "MsgBox " & Chr(34) & "This is a new workbook"
End WithSub Worksheet_eventprocedure_copy() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Subc01= .Lines(.ProcStartLine("Worksheet_Change",0),.ProcCountlines("Worksheet_Change",0))
End WithWith Workbooks(2).VBProject.VBComponents("Sheet2").CodeModule .AddFromString c01
End WithSub Worksheet_eventprocedure_verplaatsen() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Subc01= .Lines(.ProcStartLine("Worksheet_Change",0),.ProcCountlines("Worksheet_Change",0)
End With) .deletelines .ProcStartLine("Worksheet_Change",0),.ProcCountlines("Worksheet_Change",0) With Workbooks(2).VBProject.VBComponents("Sheet2").CodeModule .AddFromString c01
End WithYou can add code to a activeX control event (e.g. Click, Change, Activate). The VBA code for an ActiveX control event is part of the worksheet codemodule. 4.1 All ActiveX controls in a worksheet Sub alle_ActiveX_controls() For Each cl In Sheets("Sheet1").OLEObjects
End Subc01 = c01 & vbLf & cl.Name
NextMsgBox c01 Sub ActiveX_object_toevoegen() With sheets("Sheet1")
End SubWith .OLEObjects.Add("Forms.CommandButton.1",,,,,,,40,60,40,24)
End With.Name="knop_vervolg"
End WithWith .Object
End With.Caption="Mededeling"
End With.Font.Size=9 .ForeColor=vbBlue Sub ActiveX_tekstvak_toevoegen()
Sheets("Sheet1").OLEObjects.Add("Forms.Textbox.1", , , , , , , 40, 60, 40, 24).Name ="tekst_1"
End Sub4.2.2 Worksheet OptionButton: add Sub ActiveX_keuzerondje_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.OptionButton.1").Name =""keus_1""
End SubSub ActiveX_selectievak_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.CheckBox.1").Name ="selectie_1"
End SubSub ActiveX_bijschrift_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.Label.1").Name ="bijschrift_1"
End Sub4.2.5 Worksheet CommandButton: add Sub ActiveX_opdrachtknop_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.CommandButton.1").Name ="opdracht_1"
End Sub4.2.6 Worksheet ToggleButton: add Sub ActiveX_wisselknop_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.ToggleButton.1").Name ="wissel_1"
End Sub4.2.7 Worksheet SpinButton: add Sub ActiveX_kringveld_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.SpinButton.1").Name ="spinner_1"
End SubSub ActiveX_keuzelijst_met_invoervak_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.ComboBox.1").Name ="uitklap_1"
End SubSub ActiveX_keuzelijst_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.ListBox.1").Name ="keuzen_1"
End SubSub ActiveX_groepsvak_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.Frame.1").Name ="kader_1"
End Sub4.2.11 Worksheet Tabstrip: add Sub ActiveX_tabstrook_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.TabStrip.1").Name ="tab_1"
End Sub4.2.12 Worksheet MultiPage: add Sub ActiveX_multipage_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.MultiPage.1").Name ="multi_1"
End Sub4.2.13 Worksheet ScrollBar: add Sub ActiveX_schuifbalk_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.ScrollBar.1").Name ="schuif_1"
End SubSub ActiveX_afbeelding_toevoegen()
Sheets("Sheet1").OLEObjects.Add("forms.Image.1").Name ="plaatje_1"
End SubSub AciveX_kopie() Sheets("Sheet1").OLEObjects("tekstvak1").Copy
End SubSheets("Sheet2").Paste Sub ActiveX_hernoemen() Sheets("Sheet1").OLEObjects("knop_vervolg").Name = "knop_einde"
End SubSub ActiveX_delete() Sheets("Sheet1").OLEObjects("knop_vervolg").delete
End SubSub ActiveX_eventcode_zoeken MsgBox "knop_vervolg_Click" & ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.Find("Sub knop_vervolg_Click(","","niet ") & "found
End SubSub ActiveX_eventcode_lezen ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End SubMsgBox .Lines(.ProcStartLine("knop_vervolg_Click",0), .ProcCountLines("knop_vervolg_Click",0))
End withSub ActiveX_eventcode_toevoegen() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Sub.InsertLines .CreateEventProc("Click", "knop_vervolg") + 1,vbTab & "MsgBox " & Chr(34) & "Je hebt knop_vervolg aangeklikt"
End WithSub ActiveX_eventcode_kopie() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Sub.AddFromString replace( .Lines(.ProcStartLine("textbox1_Change",0), .ProcCountLines("textbox1_Change",0)),"textbox1","textbox2")
End WithSub ActiveX_eventcode_copy2() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
End Subc00 = .Lines(.ProcStartLine("tekstvak1_Change",0), .ProcCountLines("textbox1_Change",0))
End WithThisWorkbook.VBProject.VBComponents("Sheet2").CodeModule.AddFromString c00 With ThisWorkbook.VBProject with .VBComponents("Sheet1").codemodule
End Withc00 =.lines(.ProcStartLine("knop_vervolg_Click",0), .ProcCountLines("knop_vervolg_Click",0))
end with.DeleteLines .ProcStartLine("knop_vervolg_Click",0), .ProcCountLines("knop_vervolg_Click",0) .VBComponents("Sheet2").codemodule.AddFromString c0. 4.6.6 ActiveX eventcode: replace Sub ActiveX_code_vervangen1() With ThisWorkbook.VBProject.VBComponents("Sheet1").codemodule .ReplaceLine .ProcStartLine("knop_vervolg_Click",0), Replace(.Lines(.ProcStartLine("knop_vervolg_Click",0), 1), "_vervolg", "_einde")
End With
End SubSub ActiveX_code_vervangen2() With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule .DeleteLines .ProcStartLine("knop_vervolg_Click",0) + 1, .ProcCountLines("knop_vervolg_Click",0) - 2
End With
End Sub.InsertLines .ProcStartLine("knop_vervolg_Click",0) + 1,"c00 = " & Chr(34) & "Dit is de nieuwste tekst" 4.6.7 ActiveX eventcode: delete Sub ActiveX_code_delete() With ThisWorkbook.VBProject.VBComponents("Sheet1").codemodule
End Sub.DeleteLines .ProcStartLine("knop_vervolg_Click",0), .ProcCountLines("knop_vervolg_Click",0)
End With
5.3.1 All eventprocedures in a Userform The startline of each eventprocedure in a userform contains the string ' Sub Userform_'Sub alle_eventprocedures_in_userform() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End SubMsgBox join(filter( split(.Lines(1, .CountOfLines),vbCrLf),"Sub UserForm_"),vbLf)
End WithSub eventprocedure_zoeken() msgbox"Userform_Initialize" & iif(ThisWorkbook.VBProject.VBComponents("invoer").CodeModule.Find("Sub Userform_Initialize(", 1, 1, -1, -1),"", "niet") & "found"
End SubSub eventprocedure_lezen() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Subc01 = .Lines(.ProcStartLine("Userform_Initialize", 0), .ProcCountLines("Userform_Initialize", 0))
End WithSub eventprocedure_delete() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Sub.DeleteLines .ProcStartLine("Userform_Initialize",0),.ProcCountlines("Userform_Initialize",0)
End WithSub eventprocedure_toevoegen() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Sub.InsertLines .CreateEventProc("Initialize", "Userform") + 1,vbTab & "MsgBox " & Chr(34) & "This is a new workbook"
End WithSub eventprocedure_copy() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Subc01= .Lines(.ProcStartLine("Userform_Initialize",0),.ProcCountlines("Userform_Initialize",0))
End WithWith Workbooks(2).VBProject.VBComponents("invoer").CodeModule .AddFromString c01
End WithSub eventprocedure_verplaatsen() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Subc01= .Lines(.ProcStartLine("Userform_Initialize",0),.ProcCountlines("Userform_Initialize",0))
End With.deletelines .ProcStartLine("Userform_Initialize",0),.ProcCountlines("Userform_Initialize",0) With Workbooks(2).VBProject.VBComponents("invoer").CodeModule .AddFromString c01
End WithSub alle_besturingselementen() For Each ct In ThisWorkbook.VBProject.VBComponents("invoer").Designer.Controls
End Subc01 = c01 & vbLf & ct.Name
Nextmsgbox c01 , , "controls in this userform" Sub Userform_alle_besturingselementen() For Each ct InUserForm1.Controls
End Subc01 = c01 & vbLf & ct.Name
NextMsgBox c01, , "besturingselementen in" &UserForm1.Name Sub Userform_besturingselement_toevoegen() With ThisWorkbook.VBProject.VBComponents("invoer").Designer.Controls.Add("forms.commandButton.1", "knop_einde")
End Sub.Caption = "Stop"
End With.Top =120 .Left =120 Sub Userform_tekstvak_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.Textbox.1").Name = "tekst_1"
End Sub5.4.2.2 Userform OptionButton: add Sub Userform_keuzerondje_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.OptionButton.1").Name = "keus_1"
End Sub5.4.2.3 Userform CheckBox: add Sub Userform_selectievak_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.CheckBox.1").Name = "selectie_1"
End SubSub Userform_bijschrift_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.Label.1").Name = "bijschrift_1"
End Sub5.4.2.5 Userform CommandButton: add Sub Userform_opdrachtknop_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.CommandButton.1").Name = "opdracht_1"
End Sub5.4.2.6 Userform ToggleButton: add Sub Userform_wisselknop_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.ToggleButton.1").Name = "wissel_1"
End Sub5.4.2.7 Userform SpinButton: add Sub Userform_kringveld_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.SpinButton.1").Name = "spinner_1"
End Sub5.4.2.8 Userform ComboBox: add Sub Userform_keuzelijst_met_invoervak_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.ComboBox.1").Name = "uitklap_1"
End SubSub Userform_keuzelijst_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.ListBox.1").Name = "keuzen_1"
End SubSub Userform_groepsvak_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.Frame.1").Name = "kader_1"
End Sub5.4.2.11 Userform Tabstrip: add Sub Userform_tabstrook_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.TabStrip.1").Name = "tab_1"
End Sub5.4.2.12 Userform MultiPage: add Sub Userform_multipage_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.MultiPage.1").Name = "multi_1"
End Sub5.4.2.13 Userform ScrollBar: add Sub Userform_schuifbalk_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.ScrollBar.1").Name = "schuif_1"
End SubSub Userform_afbeelding_toevoegen() ThisWorkbook.VBProject.VBComponents("invoer").designer.Controls.Add("forms.Image.1").Name = "plaatje_1"
End SubSub Userform_besturingselement_copy() With ThisWorkbook.VBProject
End SubWith .VBComponents("input").Designer
End With.Controls("knop_einde").SetFocus
End With.Copy .VBComponents("input2").Designer.Paste 5.4.4 Userform control: rename Sub Userform_besturingselement_hernoemen() With ThisWorkbook.VBProject.VBComponents("input")
End Sub.Designer.Controls("knop_einde").Name = "knop_slot"
End With5.4.5 Userform control: delete Sub Userform_besturingselement_delete() With ThisWorkbook.VBProject.VBComponents("invoer")
End Sub.Designer.Controls.Remove "knop_einde"
End With5.4.6 Userform control: events 5.4.6.1 All event code of a certain Userform control Sub Userform_alle_besturingselementcode_van_een_bepaald_besturingselement() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Subsn = Filter(Split(.Lines(1, .countoflines), vbCrLf), "Sub TextBox1_")
End WithFor j = 0 To UBound(sn)(br/> sn(j) = .Lines(.ProcStartLine(Split(Split(sn(j), "Sub ")(1), "(")(0), 0), .ProcCountLines(Split(Split(sn(j), "Sub ")(1), "(")(0), 0))
Next5.4.6.2 Userform control eventcode: find Sub besturingselement_code_zoeken() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End SubMsgBox "knop_einde_Click event" & iif(.Find("Sub knop_einde_Click("),"","niet ") & "found" End with5.4.6.3 Userform control eventcode: read Sub besturingselement_code_lezen() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End SubMsgBox .Lines(.ProcStartLine("knop_einde_Click",0), .ProcCountLines("knop_einde_Click",0))
End with5.4.6.4 Userform control eventcode: add Sub besturingselementcode_toevoegen() With ThisWorkbook.VBProject.VBComponents("invoer").CodeModule
End Sub.InsertLines .CreateEventProc("Click","knop_einde")=1,"MsgBox " & chr(34) & "Controleer alle gegevens"
End With5.4.6.5 Userform control eventcode: copy copy the eventcode of control Knop_einde_click in Userform1 ("input") to Userform2 ("input2")Sub besturingselement_code_kopie() With ThisWorkbook.VBProject
End SubWith .VBComponents("input").CodeModule
End withc00 = .Lines(.ProcStartLine("knop_einde_Click",0), .ProcCountLines("knop_einde_Click",0))
End With.VBComponents("input2").CodeModule.AddFromString c00 Sub besturingselement_code_kopie2() With ThisWorkbook.VBProject.VBComponents("input").CodeModule
End Sub.AddFromString replace(.Lines(.ProcStartLine("textbox1_Change",0), .ProcCountLines("tekstvak1_Change",0)),"textbox1","textbox2")
End With5.4.6.6 Userform control eventcode: replace The startline and the endline of the eventprocedure remain; the lines inbetween ere being replaced.Sub besturingselement_code_vervangen() With ThisWorkbook.VBProject.VBComponents("input").CodeModule
End Sub.ReplaceLines .ProcStartLine("knop_einde_Click",0) + 1, .ProcCountLines("knop_einde_Click",0) - 2, .ProcStartLine("knop_einde_Click",0) + 1,"MsgBox " & Chr(34) & "Dit is de nieuwste tekst"
End With5.4.6.7 Userform control eventcode: adapt Sub besturingselement_code_aanpassen() With ThisWorkbook.VBProject.VBComponents("invoer").codemodule
End Sub.ReplaceLine .ProcStartLine("knop_einde_Click",0), Replace(.Lines(.ProcStartLine("knop_einde_Click",0), 1), "_einde", "_slot")
End With5.4.6.8 Userform control eventcode: delete Sub besturingselement_code_delete() With ThisWorkbook.VBProject.VBComponents("invoer").codemodule
End Sub.DeleteLines .ProcStartLine("knop_vervolg_Click",0), .ProcCountLines("knop_vervolg_Click",0)
End With |