Code in VBEModul nicht in Tabellenmodul mit VBA schreiben

[R G K]

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!

    
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 eintragen

 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

[Jeanie]

Hi,
ThisWorkbook.VBProject.VBComponents("mdlGlobalConst")
sollte den Trick tun.

mdlGlobalConst ist kein Objekt wie du es mit dem Tabellenobjekt übergeben hast.

[R G K]

Hallo Jeanie,
Danke, bekomme leider immer noch Fehler!
Mit
With ThisWorkbook.VBProject.VBComponents("mdlGlobalConst")
        .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
Bleibt der Code bei   .DeleteLines intLineNr stehen

mit Laufzeitfehler '438': Objekt unterstützt diese Eigenschaft oder Methode nicht




mit  der Variante
With ThisWorkbook.VBProject.VBComponents("mdlGlobalConst").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

Kommt Laufzeitfehler '91':   Objektvariable oder With-Blockvariable nicht festgelegt


Grüße Rolf

[Jeanie]

Hi,
im ersten Fall muss der Fehler kommen, da du nicht CodeModule ansprichst, welches die Methoden zur Verfügung stellt.

Im zweiten Fall wäre es hilfreich, in welcher Zeile das abfliegt und ob dein Modul wirklich so heißt.

Hast du einen Verweis auf die Extensiblity gesetzt, damit du die Intellisense hast?


Zum Testen

Modul2 mit ein paar Zeilen
Ein anderes Modul mit diesem Code

Sub dellines()
Dim VBComp As VBComponent
Set VBComp = ThisWorkbook.VBProject.VBComponents("Modul2")
Call VBComp.CodeModule.DeleteLines(1, 2)
End Sub

Ich bin dann mal weg :05:

[RPP63]

[off topic]
Bin ein wenig(!) neugierig, wer sich hinter der (bezaubernden [you know? J.R. Ewing in jung]) Jeanie verbirgt …
Ich ahne es …  :21:

Welcome!
Gruß Ralf