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