Inserting code into command buttons using vba? 1

[fenris]

I have a form that has a number of buttons, I can create the buttons programmatically with out a problem and set all the various properties that I require. What I want to be able to do is set the code that the button executes when it is clicked by using vba.

Any ideas?
Troy Williams B.Eng.
fenris@hotmail.com

 

[KiltedCelt]

If you just mean you want to write the code that excutes when you push the button while the program is running then just double click the button during design and the code window will pop up or you can just right click the button and choose view code. Enter your code there. Hope this helps.

 

[Kaah]

fenris,

I have done a small amount of stuff like this before, I think you will ave the least trouble by predefining the code for eac button into a *.bas file, and then using the project object to import te code as the need arises. I'm not sure that you'll be able to compose the code dynamically if thats what you're after. I have included code below that does NOTHING like what you're after, but it does give you te idea regarding the vbproject object. The code below actually exports all modules from a project. The import method isn't that much different and with a little experimentation you'll get it in no time (i've done it before, I just cant find the code- sorry!)

Sub ExportAllModules()

Dim iComponent As Integer
Dim sCompName As String
Dim sPath As String
Dim sExtn As String

sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_Modules"
If Dir(sPath, vbDirectory) = "" Then MkDir sPath
For iComponent = 1 To ThisWorkbook.VBProject.VBComponents.Count
sCompName = ThisWorkbook.VBProject.VBComponents.Item(iComponent).Name
If ThisWorkbook.VBProject.VBComponents.Item(iComponent).Type = 1 Then
sExtn = ".bas"
ElseIf ThisWorkbook.VBProject.VBComponents.Item(iComponent).Type = 3 Then
sExtn = ".frm"
Else
sExtn = ".cls"
End If
ThisWorkbook.VBProject.VBComponents.Item(iComponent).Export (sPath & "\" & sCompName & sExtn)
Next iComponent

End Sub


hope this helps. I'm sure you can work it out from here..

Kaah.

BTW. The object model for vbproject between Excel 97-2000 is different. The code above is for 2000. If you need sample code for 97 let me know.

 

[ratman]

Hi Kaah,
Do you have the Excel'97 version?
Much appreciated!
Thanks,
Dave

 

[ratman]

I HAVE NO CLUE IF THIS WILL WORK FENRIS SINCE I HAVE NEVER TRIED IT.

Sub Export_CodeModule()

Dim wbExport As Workbook

Dim CodeLines$


With ThisWorkbook.VBProject.VBComponents("modExport&quot.CodeModule


' Initialize a string variable for the VBA code text in the
' original module

CodeLines$ = .Lines(1, .CountOfLines)

End With


With wbExport.VBProject.VBComponents


' The value of 1 is the equivalent of the vb constant for
' vbext_ct_StdModule (standard module - the type of component
' to be added)

.Add 1

With .Item(.Count).CodeModule


' Delete any code in the new module (such as an
' Option Explicit declaration statement)

.DeleteLines 1, .CountOfLines


' "Paste" the code

.AddFromString CodeLines$

End With

End With

End Sub

This initializes a string variable with the contents of a module named modExport in the originating workbook. In the destination workbook, represented by the wbExport object variable, a new module is added and the contents are written to it.

Note the statement:

.DeleteLines 1, .CountOfLines

This compensates for a declaration that can automatically appear at the top of a new module. For instance, if the user has the Require Variable Declaration option turned on (an excellent practice), then unless you explicitly delete all lines in the fresh module, it could produce an error from having Option Explicit twice.


--------------------------------------------------------------------------------

Now that you've added a new module into your target workbook (wbExport), how do you name it ?

Since a new module comes in as "Module1", the following procedure will usually handle the job.

Sub RenameModule1()

Dim vbm

For Each vbm In wbExport.VBProject.VBComponents
With vbm
If .Name = "Module1" Then .Name = "NewModuleName"
End With
Next vbm

End Sub

If you have a project in which for some reason the new module isn't created as "Module1", you can take the following approach:
Read all the existing module names into an array.


Create the new module.


Find which name isn't present in your array of names.


Rename that module.

 

[Kaah]

Ratman,

sorry it took so long, heres the 97 version. Subtle but important differences. The three subs below import, export and remove modules from projects dynamically. If you put them into the workbook_beforesave method, it will preserve your code in the case of the workbook becoming corrupted during the save process; I use it religously after some bad experiences. Enjoy!

Sub ExportAllModules()

Dim VBProj As VBProject
Dim VBComps As VBComponents
Dim VBComp As VBComponent

Dim sPath As String
Dim sExtn As String

Set VBProj = ThisWorkbook.VBProject
Set VBComps = VBProj.VBComponents

sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_Modules"
If Dir(sPath, vbDirectory) = "" Then MkDir sPath

For Each VBComp In VBComps

With VBComp
Select Case .Type
Case vbext_ct_StdModule
sExtn = ".bas"
Case vbext_ct_MSForm
sExtn = ".frm"
Case Else
sExtn = ".cls"
End Select

If sExtn <> &quot;&quot; Then VBComp.Export sPath & &quot;\&quot; & .Name & sExtn

End With

Next VBComp

End Sub

Sub ImportAllModules()

Dim VBProj As VBProject
Dim VBComps As VBComponents
Dim VBComp As VBComponent
Dim sVBCompName As String
Dim sFileName As String
Dim sPath As String
Dim sExtn As String
Dim iFileIdx

Set VBProj = ThisWorkbook.VBProject
Set VBComps = VBProj.VBComponents

sPath = ThisWorkbook.Path & &quot;\&quot; & ThisWorkbook.Name & &quot;_Modules&quot;
If Dir(sPath, vbDirectory) = &quot;&quot; Then
MsgBox &quot;Directory does not exist&quot;, vbCritical
Exit Sub
End If

With Application.FileSearch
.NewSearch
.LookIn = sPath
.FileName = &quot;*.frm; *.bas; *.cls&quot;
.Execute

For iFileIdx = 1 To .FoundFiles.Count
sFileName = .FoundFiles(iFileIdx)
sVBCompName = Dir(sFileName)
sVBCompName = Left(sVBCompName, Len(sVBCompName) - 4)

Select Case Right(sFileName, 4)
Case &quot;.frm&quot;
VBComps.Import sFileName

With VBComps(sVBCompName).CodeModule
'\ remove leading blank lines
While .Lines(1, 1) = &quot;&quot;
.DeleteLines 1, 1
Wend
While .Lines(.CountOfLines, .CountOfLines) = &quot;&quot;
.DeleteLines .CountOfLines, .CountOfLines
Wend
End With

Case &quot;.cls&quot;
With VBComps(sVBCompName).CodeModule

'\ remove all code from document class codemodules
.DeleteLines 1, .CountOfLines
.AddFromFile sFileName

'\ remove VISUAL BASIC version header
.DeleteLines 1, 4

'\ remove leading blank lines
While .Lines(1, 1) = &quot;&quot;
.DeleteLines 1, 1
Wend
While .Lines(.CountOfLines, .CountOfLines) = &quot;&quot;
.DeleteLines .CountOfLines, .CountOfLines
Wend
End With

Case &quot;.bas&quot;
If Dir(sFileName) <> &quot;modAMacros.bas&quot; Then

VBComps.Import sFileName

With VBComps(sVBCompName).CodeModule
'\ remove leading blank lines
While .Lines(1, 1) = &quot;&quot;
.DeleteLines 1, 1
Wend
While .Lines(.CountOfLines, .CountOfLines) = &quot;&quot;
.DeleteLines .CountOfLines, .CountOfLines
Wend
End With
End If

End Select
Next iFileIdx
End With

End Sub

Sub RemoveAllModules()

Dim VBProj As VBProject
Dim VBComps As VBComponents
Dim VBComp As VBComponent

Dim sExtn As String

Set VBProj = ThisWorkbook.VBProject
Set VBComps = VBProj.VBComponents

For Each VBComp In VBComps

With VBComp
Select Case .Type
Case vbext_ct_StdModule
sExtn = &quot;.bas&quot;
Case vbext_ct_MSForm
sExtn = &quot;.frm&quot;
Case vbext_ct_ClassModule
sExtn = &quot;.cls&quot;
Case vbext_ct_Document
sExtn = &quot;&quot;
End Select

If .Name <> &quot;modAMacros&quot; And sExtn <> &quot;&quot; Then
VBComps.Remove VBComp
End If

End With

Next VBComp
End Sub