mögliche Fehlerquelle dieser Code?!?
30.09.2004 10:20:14
Rico
ich hab einen einzigen Code welcher nicht per Button gestartet wird... (ich hab unterdessen die Mappe aufbekommen und den Code kopiert welcher mir ein "Bug" von Excel97 beheben soll);
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Aw As Window
Dim FixCell As Range
Dim AppVers As String
Dim Oc As Range
Set Aw = ActiveWindow
Set FixCell = [J3] 'Zelle der Fixierung
AppVers = Application.Version 'Excelversion
On Error GoTo fehler
If Val(AppVers) <> 8 Then Exit Sub 'gilt nur für Excel97
If Target.Validation.InCellDropdown = True Then
If Target.Row < FixCell.Row Or Target.Column < FixCell.Column Then Aw.FreezePanes = False
End If
Exit Sub
fehler:
If Aw.Panes.Count > 1 Then Exit Sub 'Wenn Fixierung aktiv, Sub beenden
Application.EnableEvents = False
Set Oc = Target 'aktive Zelle zwischenspeichern
FixCell.Select 'Das gehört zu dem einen Prozent, wo es ohne SELECT nicht geht
Aw.FreezePanes = True 'Fixierung wieder an alter Stelle setzen
Oc.Select 'wieder aktive Zelle ansteuern
Application.EnableEvents = True
End Sub
kann es sein, dass dieser Code mir die Datei aufbläht?
folgende Makros hab ich noch in einem Blatt als "Sortierhilfe" per Button eingegliedert (normal als einzelne Module eingefügt):
Modul 1:
Sub AB_nachfassen()
Range("D3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="noch nicht erhalten"
Selection.AutoFilter Field:=7, Criteria1:="offen"
End Sub
Sub alle_einblenden()
Selection.AutoFilter
End Sub
Sub anstehende_Montagen()
Range("C3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="Montage"
Selection.AutoFilter Field:=7, Criteria1:="offen"
End Sub
Modul 2:
Sub Transporte_noch_organisieren()
Range("F3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:="noch organisieren"
Selection.AutoFilter Field:=7, Criteria1:="offen"
End Sub
Modul 3:
Sub offene_Aufträge()
Range("G3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=7, Criteria1:="offen"
End Sub
Modul 6: (andere Module wurden vorgängig gelöscht.. )
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column <> 1 Then Exit Sub
If [a:a].Find(Target, lookat:=xlWhole).Row < Target.Row Then
Application.EnableEvents = False
Target = ""
MsgBox "Doppelt!"
Application.EnableEvents = True
End If
End Sub
Modul 8:
Sub Montagetermine_sortieren()
Range("E3").Select
Selection.Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
SOORRYYY... für das grosse posting... aber vielleicht hilft das zur Lösung meines Problems...
Gruss Rico