Anzeige
Archiv - Navigation
1064to1068
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code kopieren & Zeile austauschen = Absturz

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
Anzeige
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
Anzeige
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
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige