Floating Button

[ExcelNeuling99]

Hallo zusammen,

ich suche gerade eine Lösung (die ich aber bisher noch nie gesehen habe).

und zwar habe ich in dem Beispieldokument einen Button mit Makro erstellt, der automatisch alle Filter zurücksetzt. Meine "working" Tabelle hat aber extrem viele Spalten und dadurch muss man seitlich lange zum Button scrollen. Daher wäre es optimal, wenn dieser Button "mitscrollt" und damit immer an der gleichen Stellen (oben links am Bildschirm) ist. Ist dies möglich?

Vielen Dank!

[WillWissen]

Hi,

schau mal in diesen Beitrag - ist das die Lösung? http://www.office-loesung.de/ftopic411266_0_0_asc.php

[shift-del]

Hallo

Warum nicht einfach die bereits eingebaute Lösung verwenden?

Symbolleiste für den Schnellzugriff anpassen -> Alle Befehle -> Alle Filter löschen -> Hinzufügen -> OK

[ExcelNeuling99]

Leider komme ich mit dem oben genannten Link nicht weiter. In dem dortigen Codebeispiel fehlen mir die Erklärungen:(

Das mit der Symbolleiste hat leider 2 Probleme:

1. Ich benutze einen Blattschutz, wodurch diese Funktion nicht mehr geht.
   
2. Verschiedene Benutzer haben Zugriff auf die Tabelle und nicht jeder wird sein Excel entsprechend einrichten.
   

[M.Wichmann]

Kannst du nicht einfach die Ansicht zb auf SpalteA fixieren? Wenn der Button da ist, ist er immer Sichtbar. Wenn das wirklich so in etwas deine Tabelle ist, wäre es ehh von Vorteile die Bauteilenummer immer zu sehen.

[Matthias84]

Hallo,

warum startest du dein Makro nicht über die Symbolleiste für den Schnellzugriff?

[Kuwer]

Leider komme ich mit dem oben genannten Link nicht weiter. In dem dortigen Codebeispiel fehlen mir die Erklärungen:(

Hallo,

auf Deine Beispielmappe bezogen dann so:

Microsoft Excel Objekt DieseArbeitsmappe

Option Explicit 



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 

ActiveSheet.Range("Tabelle1").ListObject.AutoFilter.ShowAllData 

ActiveSheet.Range("B1").Value = "" 

End Sub 



Private Sub Workbook_Activate() 

 If ActiveSheet.Name = "Tabelle1" Then Application.Run Me.Worksheets("Tabelle1").CodeName & ".Worksheet_Activate" 

End Sub 



Private Sub Workbook_Deactivate() 

 If ActiveSheet.Name = "Tabelle1" Then Application.Run Me.Worksheets("Tabelle1").CodeName & ".Worksheet_Deactivate" 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Microsoft Excel Objekt Tabelle1

Option Explicit 



Dim bolNoLoop As Boolean 

Dim datNext As Date 



Private Sub Worksheet_Change(ByVal Target As Range) 

Dim i, k As String 

Dim ArrWerte As Variant 

Dim n As Long 

If Target.Address = "$B$1" Then 

With ListObjects("Tabelle1") 

  k = Range("B1").Text 

  ArrWerte = .ListColumns(4).DataBodyRange 

  For n = 1 To Ubound(ArrWerte, 1) 

    If InStr(1, ArrWerte(n, 1), k, 1) Then i = i & " " & ArrWerte(n, 1) 

  Next n 

  If i <> "" Then 

    ArrWerte = Split(Mid(i, 2)) 

    ListObjects("Tabelle1").Range.AutoFilter Field:=4, Criteria1:=ArrWerte, Operator:=xlFilterValues 

  Else 

    ListObjects("Tabelle1").Range.AutoFilter Field:=4, Criteria1:="", Operator:=xlFilterValues 

  End If 

End With 

End If 

End Sub 



Private Sub Worksheet_Activate() 

 bolNoLoop = False 

 ButtonNachfuehren 

End Sub 



Private Sub Worksheet_Deactivate() 

 bolNoLoop = True 

 ButtonNachfuehren 

End Sub 



Private Sub ButtonNachfuehren() 

 If bolNoLoop = True Then 

   On Error Resume Next 

   Application.OnTime datNext, Me.CodeName & ".ButtonNachfuehren", True, False 

   On Error GoTo 0 

 Else 

   Me.Shapes("Rechteck 1").Top = ActiveWindow.VisibleRange.Top 

   Me.Shapes("Rechteck 1").Left = ActiveWindow.VisibleRange.Left 

   datNext = Now + TimeSerial(0, 0, 1) 

   Application.OnTime datNext, Me.CodeName & ".ButtonNachfuehren", False, True 

 End If 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

  Tabelle über Suchfeld filtern_Kuwer.xlsm (Größe: 21,17 KB / Downloads: 6)

Gruß Uwe