Haken setzen und löschen auf verschiedenen Blättern

[Horst Werner]

Hallo Zusammen,

ich versuche in Excel einen Haken zu setzen.

Dass der Haken gesetzt wird klappt schon mal, mit links klick wird dieser gesetzt und nochmal klicken wieder entfernt.
Es darf immer nur maximal ein Hacken in der Spalte existieren, das geht auch.
Ich setze diese mit dem Zeichen ü und habe die Spalte mit der Schrift Wingdings formatiert.

Nun zu meinen Problemen:

1. Der Haken darf nur in Spalte A gesetzt werden. Das wird auch bis jetzt gemacht, aber wenn ich in eine andere Spalte klicke kommt eine Fehlermeldung:
"Laufzeitfehler '91' Objektvariable oder with-Blockvariable nicht festgelegt"

2. Ist es noch möglich das nur ein Haken auf Tabellenblatt 2, 3 oder 4 gesetzt wird?

Ich meine das dort immer nur maximal ein Haken auf diesen 3 Blättern existiert!
Wenn als jemand den haken auf Blatt 3 setzt wird der zuvor gesetzt Haken von Blatt 2 gelöscht.


Noch kurz zur Erklärung,

ich habe mehrere große Datenblätter auf den verschiedenen Tabellenblättern.
Ich würde gerne, dass ich mit einem Haken die Richtige Zeile auswähle und diese dann auf meinen Mainblatt (Blatt 1) übergebe. Damit ich dort mit den Daten rechnen kann.

hier der bis jetzt bestehende Code-ansatz:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Target.Value = "ü" Then
                Target.Value = ""
            Else       
Intersect(Target.EntireColumn, Range("A:A")).ClearContents
                Target.Value = "ü"
            End If
            Cancel = True
    End Sub



Danke für jede Idee oder Lösungsansatz.

Gruß
Horst

[Kuwer]

Hallo Horst,

entferne alle Doppelklick-Makros und füge dann dieses in das VBA-Modul DieseArbeitsmappe ein:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim i As Long
  Select Case Sh.Index
    Case 2 To 4
      If Target.Column = 1 Then
        If Target.Value = "ü" Then
          Target = ""
          Sheets(1).Cells(3, 1).Resize(, 10) = ""
        Else
          For i = 2 To 4
            Sheets(i).Cells.Replace What:="ü", _
                             Replacement:="", _
                                  LookAt:=xlWhole, _
                             SearchOrder:=xlByRows, _
                               MatchCase:=False, _
                            SearchFormat:=False, _
                           ReplaceFormat:=False
          Next i
          Target.Value = "ü"
          Target.Offset(, 1).Resize(, 10).Copy Sheets(1).Cells(3, 1)
        End If
        Cancel = True
      End If
  End Select
End Sub

Gruß Uwe

[Horst Werner]

Guden Uwe,

ich danke dir, für deine schnelle und super Hilfe.
Funktioniert alles super.
Habe nur noch diese Funktion gefunden (ActiveCell.Font.Name = "Wingdings") damit ich mir die formatieren sparen kann.
Danke.
Gruß Horst
Bleib Gesund^^

[Horst Werner]

Guten Morgen Uwe,

habe leider noch ein Problem, was ich nicht beseitigt bekomme.
Habe das Problem das ich auf meinen Tabellenblatt einen Blattschutz aktivieren muss.
Dadurch habe ich das Problem das Zeile 1 - 5 der Spalte A und das Restliche Tabellenblatt einem Blattschutz unterliegen,
wenn ich jetzt dort rein klicke bekomme ich einen Laufzeitfehler '1004'.
Jetzt kann er dort nicht "" setzen, das hatte ich vorher nicht bedacht.

Hättest du für mich dafür auch noch eine Lösung?
Achso dein Code ist wieder Original.

Danke

Gruß
Horst

[Fennek]

Hallo,

versuche den Blattschutz so zu setzen:

Code:

Sheets(“sheetname”).Protect Password:="Secret", UserInterFaceOnly:=True

Dann sind Änderungen per Makro möglich, ohne den Schutz abzuschalten.

mfg

(ungeprüft)

[Kuwer]

Hallo Horst,

Habe das Problem das ich auf meinen Tabellenblatt einen Blattschutz aktivieren muss.
Dadurch habe ich das Problem das Zeile 1 - 5 der Spalte A und das Restliche Tabellenblatt einem Blattschutz unterliegen,...

warum schließt Du die Spalte A nicht vom Schutz aus?

@Fennek

Das Protect UserInterfaceOnly:= True hatte ich gerade getestet, funktioniert aber nicht zuverlässig, weshalb ich es nicht empfehlen möchte.

Gruß Uwe

[Horst Werner]

Hallo Fennek,

danke für deine Hilfe, aber ich bekommen eine Fehlermeldung Laufzeitfehler '9'.



Hi Uwe,

die Spalte A1-A5, sollten nicht verändbar sein.

Habe das später erst gemerkt, Habe spalten überschriften, diese wird mit setzen eines Haken auch überschrieben.
Kann man irgendwie dem Makro sagen das es nur A6 - Axxxx was ändern muss?


danke euch für die Hilfe



Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 
Sheets(“Tabelle2”).Protect Password:="123", UserInterFaceOnly:=True
 
  Dim i As Long
  Select Case Sh.Index
    Case 2 To 4
      If Target.Column = 1 Then
        If Target.Value = "ü" Then
          Target = ""
          Sheets(1).Cells(3, 1).Resize(, 10) = ""
        Else
          For i = 2 To 4
            Sheets(i).Cells.Replace What:="ü", _
                            Replacement:="", _
                                  LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                              MatchCase:=False, _
                            SearchFormat:=False, _
                          ReplaceFormat:=False
          Next i
          Target.Value = "ü"
          Target.Offset(, 1).Resize(, 10).Copy Sheets(1).Cells(3, 1)
        ' Sh.Columns(1).Font.Name = "Wingdings"
        End If
        Cancel = True
      End If
  End Select
End Sub




mfg
Horst

[Kuwer]

Hallo Horst,

Kann man irgendwie dem Makro sagen das es nur A6 - Axxxx was ändern muss?

ersetze

If Target.Column = 1 Then

durch

If Target.Column = 1 And Target.Row > 5 Then

Gruß Uwe

[Horst Werner]

Klappt super.

dank dir :15: 

Gruß
Horst