Guten Tag,
ich möchte mit VBA Code in ein Modul schreiben!
Den Code in ein Tabellenmodul schreiben mit dem unten stehenden Code klappt wunderbar!
Code eingefügt mit: Excel Code Jeanie
Wie muss der Code
Set VBComp = ThisWorkbook.VBProject.VBComponents(mdlGlobalConst) richtig heisen?
Hier kommt die Fehlermeldung:
Fehler beim Kompilieren:
Variable oder Prozedur anstelle eines Moduls erwartet
?????
With VBComp.CodeModule
.DeleteLines intLineNr
.InsertLines intLineNr, strInsertString
For iCompCount = 1 To intLineNr + 4
If .Lines(iCompCount, 1) Like "*()*" Or .Lines(iCompCount, 1) Like "*Dim*" Then
.InsertLines intLineNr + 3, "'x"
'Debug.Print iCompCount & "-" & .Lines(iCompCount, 1)
End If
Next iCompCount
End With
Grüße Rolf
ich möchte mit VBA Code in ein Modul schreiben!
Den Code in ein Tabellenmodul schreiben mit dem unten stehenden Code klappt wunderbar!
Sub testaufruf()
Dim wksZiel As Worksheet
Set wksZiel = ThisWorkbook.ActiveSheet
Call Privat_Constante_Spalten(wksZiel)
End Sub
Sub Privat_Constante_Spalten(wksZiel As Worksheet)
Dim intLineNr As Integer, y As Integer, vArrUeberschriften As Variant _
, intECol As Integer, strUberschrirftString As String, strIntUeberschr As String _
, strConstUeberschr As String, lUberschriftenRow As Long, intLineNrStart As Integer
Dim LineNr As Integer
Dim strInsertString As String, strOU As String
Dim iCompCount As Integer
Dim VBComp As VBComponent, objFile As Object
With wksZiel
lUberschriftenRow = .AutoFilter.Range.Row
If lUberschriftenRow = 0 Then
lUberschriftenRow = 1
End If
intLineNrStart = 2
intLineNr = 2
intECol = .Cells(lUberschriftenRow, 256).End(xlToLeft).Column
vArrUeberschriften = .Range(.Cells(lUberschriftenRow, 1), .Cells(lUberschriftenRow, intECol))
For y = 1 To UBound(vArrUeberschriften, 2)
strUberschrirftString = vArrUeberschriften(1, y)
strOU = ReplaceText(strUberschrirftString)
strIntUeberschr = "int" & strOU
strConstUeberschr = "Cint" & strOU
strIntUeberschr = FindColumn(wksZiel, strUberschrirftString, lUberschriftenRow, True)
intLineNr = intLineNr + 1
'strInsertString = "Private Const " & strConstUeberschr & " As Integer =" & strIntUeberschr
strInsertString = "Private Const " & strConstUeberschr & " As Integer =" & strIntUeberschr
With ThisWorkbook.VBProject.VBComponents(Worksheets(wksZiel.Name).CodeName).CodeModule
.DeleteLines intLineNr
.InsertLines intLineNr, strInsertString
For iCompCount = 1 To intLineNr + 4
If .Lines(iCompCount, 1) Like "*()*" Or .Lines(iCompCount, 1) Like "*Dim*" Then
.InsertLines intLineNr + 3, "'x"
'Debug.Print iCompCount & "-" & .Lines(iCompCount, 1)
End If
Next iCompCount
End With
Next y
'Letzte Spalte als Constante
intLineNr = intLineNr + 1
oK = Code_via_VBA_Private_Const(wksZiel, intLineNr, "Private Const CintECol As Integer =" & intECol, wksZiel.Name)
End With
End Sub
Function Code_via_VBA_Private_Const(wks As Worksheet, intLineNr As Integer, strInsertString As String, Optional stringWorksheetName As String)
Dim ws As String
Dim VBC As Object
Dim LineNr As Integer
If Len(stringWorksheetName) > 2 Then
ws = stringWorksheetName
Else
ws = wks.Name
End If
With ThisWorkbook.VBProject.VBComponents(Worksheets(ws).CodeName).CodeModule
' LineNr = .CreateEventProc("BeforeDoubleClick", "Worksheet")
' .InsertLines intLineNr, " "
.DeleteLines intLineNr
.InsertLines intLineNr, strInsertString
End With
End Function
Code eingefügt mit: Excel Code Jeanie
Private Function ReplaceText(text As String)
'** Dimensionierung der Variablen
Dim Ueberschrift1 As String, Ueberschrift2 As String, Ueberschrift3 As String, Ueberschrift4 As String, _
Ueberschrift5 As String, Ueberschrift6 As String, Ueberschrift7 As String, _
Ueberschrift8 As String, Ueberschrift9 As String, Ueberschrift10 As String, _
Ueberschrift11 As String, Ueberschrift12 As String, Ueberschrift13 As String, Ueberschrift14 As String
'** Ueberschrifte umwandeln in z. B. a -> ae
Ueberschrift1 = Replace(text, "ü", "ue")
Ueberschrift2 = Replace(Ueberschrift1, "Ü", "Ue")
Ueberschrift3 = Replace(Ueberschrift2, "ä", "ae")
Ueberschrift4 = Replace(Ueberschrift3, "ÄÄ", "Ae")
Ueberschrift5 = Replace(Ueberschrift4, "ö", "oe")
Ueberschrift6 = Replace(Ueberschrift5, "Ö", "Oe")
Ueberschrift7 = Replace(Ueberschrift6, "ß", "ss")
Ueberschrift8 = Replace(Ueberschrift7, " ", "_")
Ueberschrift9 = Replace(Ueberschrift8, "(", "")
Ueberschrift10 = Replace(Ueberschrift9, ")", "")
Ueberschrift11 = Replace(Ueberschrift10, "/", "_")
Ueberschrift12 = Replace(Ueberschrift11, ",", "")
Ueberschrift13 = Replace(Ueberschrift12, ".", "")
Ueberschrift14 = Replace(Ueberschrift13, "-", "_")
ReplaceText = Ueberschrift14
End Function
Function FindColumn(oSuchSheet As Object, strSuchbegriff As String, lngSuchRow As Long, Optional Genau As Boolean) As Long
Dim rFound As Range
On Error Resume Next
With oSuchSheet
Set rFound = .Rows(lngSuchRow).Find(What:=strSuchbegriff, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=Genau, SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then FindColumn = (rFound.Column)
End With
End Function
ich möchte aber Public Const in ein Modul eintragenWie muss der Code
Set VBComp = ThisWorkbook.VBProject.VBComponents(mdlGlobalConst) richtig heisen?
Hier kommt die Fehlermeldung:
Fehler beim Kompilieren:
Variable oder Prozedur anstelle eines Moduls erwartet
?????
With VBComp.CodeModule
.DeleteLines intLineNr
.InsertLines intLineNr, strInsertString
For iCompCount = 1 To intLineNr + 4
If .Lines(iCompCount, 1) Like "*()*" Or .Lines(iCompCount, 1) Like "*Dim*" Then
.InsertLines intLineNr + 3, "'x"
'Debug.Print iCompCount & "-" & .Lines(iCompCount, 1)
End If
Next iCompCount
End With
Grüße Rolf
