faust7
02-04-2009, 08:54 AM
I need to run this macro in several files we have on our shared drive. The files are used to count the number of calls we get and in which categories these calls fall in. I intend to run the following macro to add buttons and code inside each of the buttons using VBA. When I run the macro with the extra MsgBox test messages and the delay timers, it doesn't crash. However, if I run it with only the delay timer or without any delays, it crashes and gives me error 0xc0000005. I believe that the error is caused by
With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With
Maybe it has something to do with running a sub several time within a single sub ?
Things I have tried:
Replacing the code above with MsgBox (sCode) to see if it behaves normally, and yes it does.
Removed the code above and then the macro runs smoothlyAny ideas?
In ThisWorkBook general declarations:
Public sCode As String
In Module2
Sub Macro3()
sCode = ""
'MsgBox ("test1")
'Application.Wait Now + TimeValue("00:00:01")
'MsgBox ("test2")
AjoutBouton 21, 281, 301
'MsgBox ("test3")
'Application.Wait Now + TimeValue("00:00:01")
'MsgBox ("test4")
AjoutBouton 22, 281, 317
'MsgBox ("test5")
'Application.Wait Now + TimeValue("00:00:01")
'MsgBox ("test6")
AjoutBouton 23, 281, 333
'MsgBox ("test7")
'MsgBox (sCode)
End Sub
In Module3
Sub AjoutBouton(LigneAjout As String, LeftAjout As Long, TopAjout As Long)
Dim CurSheet As Worksheet
Set CurSheet = ActiveSheet
Dim Obj As Object
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=LeftAjout, Top:=TopAjout, Width:=24.75, Height:=15)
With Obj
.Object.Caption = "^"
.Object.Font.Bold = True
.Object.Font.Size = 11
End With
sCode = ""
sCode = "Private Sub " & Obj.Name & "_Click()" & vbCrLf
sCode = sCode & "AddOneCall """ & CurSheet.Name & """ ,""" & LigneAjout & """" & vbCrLf
sCode = sCode & "End Sub"
MsgBox (CurSheet.CodeName)
MsgBox (sCode)
With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With
'Set Obj = Nothing
'Set CurSheet = Nothing
'sCode = ""
End Sub
Of course, I have a AddOneCall sub in module1 which you might want to add just so you can try to help me...
Sub AddOneCall(SheetName As String, RowNumber As Integer)
Sheets(SheetName).Range(ColumnLetter(Right(Date, 2) + 3) & RowNumber).Value = Sheets _
(SheetName).Range(ColumnLetter(Right(Date, 2) + 3) & RowNumber).Value + 1
End Sub
With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With
Maybe it has something to do with running a sub several time within a single sub ?
Things I have tried:
Replacing the code above with MsgBox (sCode) to see if it behaves normally, and yes it does.
Removed the code above and then the macro runs smoothlyAny ideas?
In ThisWorkBook general declarations:
Public sCode As String
In Module2
Sub Macro3()
sCode = ""
'MsgBox ("test1")
'Application.Wait Now + TimeValue("00:00:01")
'MsgBox ("test2")
AjoutBouton 21, 281, 301
'MsgBox ("test3")
'Application.Wait Now + TimeValue("00:00:01")
'MsgBox ("test4")
AjoutBouton 22, 281, 317
'MsgBox ("test5")
'Application.Wait Now + TimeValue("00:00:01")
'MsgBox ("test6")
AjoutBouton 23, 281, 333
'MsgBox ("test7")
'MsgBox (sCode)
End Sub
In Module3
Sub AjoutBouton(LigneAjout As String, LeftAjout As Long, TopAjout As Long)
Dim CurSheet As Worksheet
Set CurSheet = ActiveSheet
Dim Obj As Object
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=LeftAjout, Top:=TopAjout, Width:=24.75, Height:=15)
With Obj
.Object.Caption = "^"
.Object.Font.Bold = True
.Object.Font.Size = 11
End With
sCode = ""
sCode = "Private Sub " & Obj.Name & "_Click()" & vbCrLf
sCode = sCode & "AddOneCall """ & CurSheet.Name & """ ,""" & LigneAjout & """" & vbCrLf
sCode = sCode & "End Sub"
MsgBox (CurSheet.CodeName)
MsgBox (sCode)
With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With
'Set Obj = Nothing
'Set CurSheet = Nothing
'sCode = ""
End Sub
Of course, I have a AddOneCall sub in module1 which you might want to add just so you can try to help me...
Sub AddOneCall(SheetName As String, RowNumber As Integer)
Sheets(SheetName).Range(ColumnLetter(Right(Date, 2) + 3) & RowNumber).Value = Sheets _
(SheetName).Range(ColumnLetter(Right(Date, 2) + 3) & RowNumber).Value + 1
End Sub