Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1828to1832
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

Suche Tabellenblätter: Laufzeitfehler

Suche Tabellenblätter: Laufzeitfehler
19.05.2021 18:33:12
Dirk
Hallo zusammen,
ich habe eine zentrale Suchfunktion mithilfe eines Makros über mehrere Tabellenblätter. Bei einem Treffer wird die Zelle farblich unterlegt. Da mehrere User gleichzeitig auf die Datei zugreifen, habe ich eigentlich einen Blattschutz eingerichtet für alle Tabellenblätter, damit es nicht versehentlich zu Änderungen/Löschungen kommt. Leider funktioniert mit Blattschutz logischerweise die farbliche Markierung eines Suchtreffers nicht und es kommt zu einem Laufzeitfehler. Gibt es eine Lösung, das ich das Suchmakro vollumfänglich nutzen kann und trotzdem den Blattschutz aktiv habe? Nachfolgend das Suchmakro und mein Blattschutz Makro zum ein- und ausschalten:

Sub MultiSuche()
Dim Sh As Worksheet
Dim GZelle As Range, AFarbe As Long
Dim FStelle$
Dim SBegriff
SBegriff = InputBox("Bitte Suchbegriff eingeben:")
For Each Sh In Worksheets
Sh.Activate
Set GZelle = Sh.Cells.Find(SBegriff)
If Not GZelle Is Nothing Then
FStelle = GZelle.Address
Do
If GZelle.Interior.ColorIndex  xlNone Then AFarbe = GZelle.Interior.Color
GZelle.Activate
GZelle.Interior.Color = RGB(255, 0, 0)
If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then
If AFarbe = 0 Then GZelle.Interior.ColorIndex = xlNone Else GZelle.Interior.Color = AFarbe
Exit Sub
End If
If AFarbe = 0 Then GZelle.Interior.ColorIndex = xlNone Else GZelle.Interior.Color = AFarbe
Set GZelle = Cells.FindNext(after:=ActiveCell)
If GZelle.Address = FStelle Then Exit Do
Loop
End If
Next Sh
End Sub

Sub BlattSchutzEin()
Dim i As Integer
For i = 1 To Worksheets.Count
Sheets(i).Protect "garfield"
Next i
End Sub

Sub BlattSchutzAus()
Dim i As Integer
For i = 1 To Worksheets.Count
Sheets(i).Unprotect "garfield"
Next i
End 

Sub


		

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suche Tabellenblätter: Laufzeitfehler
19.05.2021 18:40:32
ralf_b
schau dir die parameter für protect in der Onlinehilfe an. Ich wdenke das userinterfaceonly da passen könnte.
AW: Suche Tabellenblätter: Laufzeitfehler
19.05.2021 18:53:03
Dirk
Danke, Ralf. Du meinst ich sollte UserInterfaceOnly:=True einbauen? Im Blattschutz Makro oder wo?
AW: Suche Tabellenblätter: Laufzeitfehler
19.05.2021 18:56:18
ralf_b
genau,
du kannst natürlich auch versuchen das einmalig zu setzen, da der vbacode dann immer arbeiten darf.
AW: Kennwort Dirk manuell setzen
19.05.2021 21:59:56
GerdL
Moin Dirk,
sicher ist, dass nichts sicher ist. ;-)

Sub MultiSuche()
Dim Sh As Worksheet
Dim GZelle As Range, AFarbe As Long
Dim FStelle$
Dim SBegriff
SBegriff = InputBox("Bitte Suchbegriff eingeben:")
For Each Sh In Worksheets
Sh.Activate
Set GZelle = Sh.Cells.Find(SBegriff)
If Not GZelle Is Nothing Then
FStelle = GZelle.Address
Do
If GZelle.Interior.ColorIndex  xlNone Then AFarbe = GZelle.Interior.Color
Sh.Unprotect "Dirk"
GZelle.Activate
GZelle.Interior.Color = RGB(255, 0, 0)
Sh.Protect "Dirk"
If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then
Sh.Unprotect "Dirk"
If AFarbe = 0 Then GZelle.Interior.ColorIndex = xlNone Else GZelle.Interior.Color = AFarbe
Sh.Protect "Dirk"
Exit Sub
End If
Sh.Unprotect "Dirk"
If AFarbe = 0 Then GZelle.Interior.ColorIndex = xlNone Else GZelle.Interior.Color = AFarbe
Sh.Protect "Dirk"
Set GZelle = Cells.FindNext(after:=ActiveCell)
If GZelle.Address = FStelle Then Exit Do
Loop
End If
Next Sh
End Sub
Gruß Gerd
Anzeige
AW: Kennwort Dirk manuell setzen
22.05.2021 11:23:26
Dirk
Hallo Gerd, Du konntest mir wieder einmal helfen. Fantastisch. Ich danke Dir. Gruß Dirk

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige