Add VB Code to Excel Spreadsheet from within Access

[JonMulder]

Greetings,

I have a form that creates an "Excel.Application" object, creates a button on the first sheet ("Sheet1"), and adds an "OnAction" module for the button.

The code gets so far as adding the button, but when I try to add the CodeModule, I get a Run-time error '9', saying subscript out of range.

Any ideas? I've got my Excel set to "Enable all macros" and to "Trust access to the VBA project object model".

Here's my code snippet:

Private Sub CmdTest_Click()
Set x1 = CreateObject("Excel.Application")
Set x1Wkbk = x1.Workbooks.Add
x1.Visible = True
x1.ActiveSheet.Buttons.Add(199.5, 20, 81, 36).Select
x1.Selection.Name = "New Button"
x1.Selection.OnAction = "CheckTotals"
x1.ActiveSheet.Shapes("New Button").Select
x1.Selection.Characters.Text = "Check Totals"
x1.Selection.OnAction = "ShowMessage"
'''Dim sht As Object
Dim shtCode As String
'''Set sht = x1.Sheets("Sheet1")
shtCode = _
   "Sub ShowMessage" & vbNewLine & _
   "Msgbox(" & Chr(34) & "Hello Jonny" & Chr(34) & ")" & vbNewLine & _
   "End Sub"
x1.Sheets("Sheet1").Select
x1.ActiveWorkbook.VBProject.VBComponents(x1.Sheets("Sheet1").CodeName).CodeModule.AddFromString shtCode
End Sub

Thanks for any help you can provide!

Jonathan Mulder

 

[Cronk]

On what line does the error occur?

 

[JonMulder]

It occurred on the following line:

x1.ActiveWorkbook.VBProject.VBComponents(x1.Sheets("Sheet1").CodeName).CodeModule.AddFromString shtCode

I have solved it! I did a search on "CodeName).CodeModule.AddFromString " and found lots of discussion.

I had to add another library reference called " Microsoft Visual Basic for Application Extensibility 5.3"

My best solution came from here:
http://stackoverflow.com/questions/...mmatically-created-worksheet-functions-in-vba

The test code below adds two buttons, then adds subroutines for each one into the VB Module for the spreadsheet. It's pretty neat!

Hope this helps other folks!

Jonathan Mulder
Engineering Geologist
California Department of Water Resources

Private Sub CmdTest_Click()
Set x1 = CreateObject("Excel.Application")
Set x1Wkbk = x1.Workbooks.Add
x1.Visible = True
x1.ActiveSheet.Buttons.Add(100, 20, 81, 36).Select
x1.Selection.Name = "New Button1"
x1.ActiveSheet.Shapes("New Button1").Select
x1.Selection.Characters.Text = "Check Totals1"
x1.Selection.OnAction = "NewSub1"
x1.ActiveSheet.Buttons.Add(200, 20, 81, 36).Select
x1.Selection.Name = "New Button2"
x1.ActiveSheet.Shapes("New Button2").Select
x1.Selection.Characters.Text = "Check Totals2"
x1.Selection.OnAction = "NewSub2"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = x1Wkbk.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
Set CodeMod = VBComp.CodeModule
With CodeMod
   .DeleteLines 1, .CountOfLines
End With
With CodeMod
    .InsertLines 1, "Sub NewSub1()"
    .InsertLines 2, "    MsgBox ""hi from your new sub1!"""
    .InsertLines 3, "End Sub"
End With
With CodeMod
    .InsertLines 4, "Sub NewSub2()"
    .InsertLines 5, "    MsgBox ""hi from your new sub2!"""
    .InsertLines 6, "End Sub"
End With
End Sub