Code kopieren & Zeile austauschen = Absturz

Forumthread: Code kopieren & Zeile austauschen = Absturz

26.03.2009 17:04:37

Andreas

Hallo Herber Fans,
Ich habe vor einigen Wochen mich in Sachen VBA Code per VBA kopieren schlau gemacht und bin auch recht weit gekommen. Nun habe ich einen Code der die Codezeilen für eine String basierte automatische AutoFiltersuche in das CodeModule des aktiven Arbeitsblattes schreibt. In der Grundversion erschien in den Zellen, in denen die AutoFilter Eingabe erfolgen soll das Wort Filtereingabe. Ich habe nun über eine UserForm eine Möglichkeit geschaffen, diesen Wert zu ändern. Entweder deutsch oder englisch, aber auch eine TextBox für eine Freie Eingabe erscheint.
Nach der Wahl der Option (deutsch/ englisch/ frei) wird aus der Beispielarbeitsmappe der Code aus dem Modul CodeToCopy in das VBA CodeModule der aktiven Arbeitsmappe (derjenigen, die den Filter erhalten soll) kopiert. So weit, so gut. Damit nun in dem Worksheet Event Code, der frisch reinkopiert wurde auch die gewählte Option sichtbar ist und verwendet wird, muß folgenden Zeile im VBA Code ersetzt werden:
strAutoFilter = "Filtereingabe" durch strAutoFilter = "[gewählte Option]"
Auch dafür habe ich schon die entsprechenden Befehlszeilen drin. Aber es funktioniert nicht. Excel stürzt komplett ab und ich habe keine Chance, mich näher an den Fehler heranzutasten.
Kann sich jemand den Code einmal ansehen und mir einen Hinweis auf den Fehler geben? Ich bin auch offen für andere Anregungen, die der Lösung dienlich sind. (AutoFilterCode in Aktive Arbeitsmappe kopieren, anschließend dauerhaft dem kopierten AutoFilterCode seine textliche Erscheinung mitgeben.) Vielleicht kann es auch cleverer über besser strukturierte Variablen gehen?
https://www.herber.de/bbs/user/60708.xls
Vielen Dank und Grüße, Andreas Hanisch

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code kopieren & Zeile austauschen = Absturz

26.03.2009 20:33:45

Nepumuk
AW: Code kopieren & Zeile austauschen = Absturz

27.03.2009 14:24:41

Andreas

AW: Code kopieren & Zeile austauschen = Absturz

26.03.2009 20:33:45

Nepumuk

Hallo Andreas,
wenn du per Makro im Editor herumfuhrwerkst, dann darfst du z.B. nicht mit ActiveSheet.CodeName arbeiten, sondern diesen Namen einer String-Variablen übergeben. Also, versuch es mal so:

' **********************************************************************
' Modul: aa_InsertStringAutoFilter Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const MSGBOX_TITLE = "Advanced AutoFilter Implementation"

Public strAutoFilter_Master As String

Sub copy_code()
    Dim strSheetname As String
    Dim rgAutoFilter As Range
    Dim objCodeModule As Object
    Dim iCounter As Integer

    strSheetname = ActiveSheet.CodeName

    '# # # (sicherer) PreCheck, ob das Ziel VBA Projekt schreibgeschützt ist oder nicht_START
    On Error GoTo ErrorHandling
    With ActiveWorkbook.VBProject.VBComponents(strSheetname).CodeModule
        .DeleteLines 1, .CountOfLines
    End With
    On Error GoTo 0
    '# # # (sicherer) PreCheck, ob das Ziel VBA Projekt schreibgeschützt ist oder nicht_ENDE

    frmInsertStringAutoFilter.Show

    If ActiveSheet.AutoFilterMode = True Then

        If MsgBox("A code for enhanced String AutoFilter will be implemented automatically." & vbLf & _
            "None of your existing cell values will be affected." & vbLf & vbLf & _
            "ATTENTION: All macros in this worksheet's VBA project will be overwritten!" & vbLf & vbLf & _
            "Continue?", vbExclamation + vbYesNo + vbDefaultButton1, MSGBOX_TITLE) = vbYes Then

            If ActiveSheet.AutoFilter.Range.Rows(1).Row = 1 Then
                ActiveSheet.Rows(1).Insert
            End If


            Application.ScreenUpdating = False

            On Error GoTo NoConstantCells
            If rgAutoFilter.SpecialCells(xlCellTypeConstants).Count > 0 Then
                ActiveSheet.Rows(ActiveSheet.AutoFilter.Range.Row).Insert
            End If
            NoConstantCells:

            On Error GoTo 0

            Set rgAutoFilter = ActiveSheet.AutoFilter.Range.Rows(1).Offset(-1, 0)
            ActiveWorkbook.Names.Add Name:="rgAutoFilter" & ActiveSheet.Name, RefersTo:=rgAutoFilter

            With rgAutoFilter
                .Value = strAutoFilter_Master
                .Font.Size = 9
                .Font.Bold = False
                .Font.ColorIndex = 5
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Interior.ColorIndex = xlNone
                .Locked = False
            End With
            Application.ScreenUpdating = True

            Set objCodeModule = ThisWorkbook.VBProject.VBComponents("CodeToCopy").CodeModule

            With ActiveWorkbook.VBProject.VBComponents(strSheetname).CodeModule
                .InsertLines 1, objCodeModule.Lines(1, objCodeModule.CountOfLines)
            End With

            With ActiveWorkbook.VBProject.VBComponents(strSheetname).CodeModule
                For iCounter = 1 To .CountOfLines
                    If .Lines(iCounter, 1) = "strAutoFilter = ""Filtereingabe""" Then
                        .ReplaceLine iCounter, "strAutoFilter = "" & strAutoFilter_Master"""
                        Exit For
                    End If
                Next iCounter
            End With


            MsgBox "The macro has successfully been implmented!" & vbLf & _
                "Tip: If the filter entry line is your first line, use the 'cursor up' " & _
                "key to confirm your entry instead of return.", vbInformation
        End If

        MsgBox "Please enable the regular AutoFilter to use " & _
            "the implemented advanced filter!", vbExclamation, MSGBOX_TITLE
    End If


    ErrorHandling:
    If Err.Number = 50289 Then
        MsgBox "Since the VBA project in this file is password protected, I can " & _
            "not insert the filter macro. Sorry.", vbExclamation, MSGBOX_TITLE
    End If

End Sub

In deinem Userform gibt' noch eine Variable? die nicht deklariert ist:

Private Sub cmdButton03_Click()
CodeApoptosis = True '?
End
End Sub

Gruß
Nepumuk

AW: Code kopieren & Zeile austauschen = Absturz

27.03.2009 14:24:41

Andreas

Hallo Nepumuk,
vielen Dank für Deine Antwort. Das mit dem Sheet Name als String ist ein guter Hinweis, der die Sache sicherer macht. Ich habe auch die CodeApoptosis Variable rausgenommen. Es war ein Überbleibsel. Ich habe den Code mit der entsprechenden Überarbeitung getestet. Er stürzt immer noch ab. Ich glaube jetzt auch zu wissen, warum. Wenn der Code einmal sauber durchläuft, wird:
strAutoFilter = "Filtereingabe"
ersetzt durch:
strAutoFilter = " & strAutoFilter_Master"
D.h. ich bekomme den Inhalt aus der Variablen strAutoFilter_Master nicht extrahiert. Wenn ich auf den SearchString Button in der UserForm clicke, dann sollte dort ja SearchString zwecks Ersetzung drin stehen. Ich habe also noch ein wenig mit den Anführungsstrichen in der Ersetzung experimentiert. Das Ergebnis: strAutoFilter = SearchString es sollte aber sein: strAutoFilter = SearchString.
https://www.herber.de/bbs/user/60748.xls
Wie kann das realisiert werden. Geht es überhaupt?
Vielen Dank, wenn Du noch eine Ideen haben sollest.
Grüße, Andreas

Beliebteste Forumthreads (12 Monate)

Code kopieren & Zeile austauschen = Absturz

Forumthread: Code kopieren & Zeile austauschen = Absturz

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread