AW: pruefen ob Prozedurname vorhanden ist
12.01.2009 17:27:50
dirk
Hallo nochmal,
hier zur Verdeutlichung mal etwas code:
Private sub
If i = 10 Then
'here comes some code to make the last checkbox react on clicking
LastButton = Selection.Name
'Put Code for the Button
'dimension the variables to add macro code in code module
'Open WBpath & "\" & "Trackreport.txt" For Append As 1
'Print #1, "Try to write macro code for button 10"
'Close 1
'Application.ScreenUpdating = False
'find last row in existing code
'cLines = ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule.CountOfLines + 1
With Workbooks(WBname).VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.InsertLines cLines + 1, "
Private Sub " & LastButton & "_Click()"
.InsertLines cLines + 2, "If bActive = True then Exit Sub"
.InsertLines cLines + 3, "LCell = ActiveSheet.OLEObjects(" & """" & LastButton & """" & _
").LinkedCell"
.InsertLines cLines + 4, "Range(LCell).Select"
.InsertLines cLines + 5, "Activecell.Offset(0, -14).Select"
.InsertLines cLines + 6, "If ActiveCell.Value = " & """" & "Other reason (Please _
specify here)" & """" & "Then"
.InsertLines cLines + 7, "If Range(LCell).Value = " & """" & "True" & """" & " Then"
.InsertLines cLines + 8, "again:"
.InsertLines cLines + 9, " OReason = InputBox(" & """Please describe the other _
reason(s) for non compliance.""" & "," & """Non-compliance reasons""" & "," _
& """Other reason (Please specify here)""" & ")"
.InsertLines cLines + 10, " If OReason = """" Then"
.InsertLines cLines + 11, "again2:"
.InsertLines cLines + 12, "tmpstr = MsgBox(" & """No valid entry. Try again?""" & ", _
vbRetryCancel)"
.InsertLines cLines + 13, "if not tmpstr = 4 then"
.InsertLines cLines + 14, "'Cancel had been selected by user'"
.InsertLines cLines + 15, " bActive = True"
.InsertLines cLines + 16, " Range(lcell).Value = " & """" & "False" & """"
.InsertLines cLines + 17, " OReason = " & """" & "Please describe the other reason( _
s) for non compliance." & """"
.InsertLines cLines + 18, " bActive = False"
.InsertLines cLines + 19, " Exit Sub"
.InsertLines cLines + 20, " Else"
.InsertLines cLines + 21, " goto again"
.InsertLines cLines + 22, " end if"
.InsertLines cLines + 23, " End If"
.InsertLines cLines + 24, " If Oreason = " & """" & "Other reason (Please specify here)" _
& """" & " then"
.InsertLines cLines + 25, " goto again2:"
.InsertLines cLines + 26, " end if"
.InsertLines cLines + 27, " ActiveCell.Value = OReason"
.InsertLines cLines + 28, "End If"
.InsertLines cLines + 29, " Else"
.InsertLines cLines + 30, " ActiveCell.Value = " & """" & "Other reason (Please specify _
here)" & """"
.InsertLines cLines + 31, "End If"
.InsertLines cLines + 32, " "
.InsertLines cLines + 33, "End Sub
"
End With
'Open WBpath & "\" & "Trackreport.txt" For Append As 1
'Print #1, "Button code for button 10 done"
'Close 1
jump:
End If
Next i
Der Name der Prozedur richtet sich nach dem Wert der Angelegten Checkbox und ich brauche im Macro die Pruefung, ob dieser Macroname schon vorhanden ist.
Gruesse
Dirk aus Dubai