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

VBA Code mit Button ein und ausschalten

VBA Code mit Button ein und ausschalten
14.08.2019 11:05:01
Krogi
Hallo zusammen,
ich möchte gerne folgenden unten gezeigten Code (Fadenkreuz-Übersicht für große Tabellen) über eine Schaltfläche (also einen Button anlegen) ein- und ausschalten können, da die Funktion nicht immer benötigt wird.
Ich bin Laie... und kriegs nicht hin. Ich hoffe auf Hilfe und bedanke mich im Voraus für jeden Hinweis.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Settings
wght = 2# 'Linienstärke in Punkt
DS = msoLineSquareDot 'linienart
'möglich sind:
'        msoLineDash            'gestrichelt
'        msoLineDashDot         'strichpunkt
'        msoLineDashDotDot      'strichpunktpunkt
'        msoLineRoundDot        'runde punkte
'        msoLineSolid           'durchgehende Linie
'        msoLineSquareDot       'eckige Punkte
FC = 23 'Farbe der Linie
'    64=schwarz
'     1=weiss
'     2=rot
'     3=grün
'     4=blau
EAL = msoArrowheadLong    'Pfeilkopflänge
'möglich sind:
'        msoArrowheadShort          'kurz
'        msoArrowheadLengthMedium   'mittel
'        msoArrowheadLong           'lang
EAW = msoArrowheadWide   'Pfeilkopfbreite
'möglich sind:
'        msoArrowheadNarrow       'dünn
'        msoArrowheadWidthMedium  'mittel
'        msoArrowheadWide         'dick
EAS = msoArrowheadStealth  'Pfeilkopfstil
'möglich sind:
'        msoArrowheadNone         'keiner
'        msoArrowheadOval         'oval
'        msoArrowheadDiamond      'diamantform
'        msoArrowheadOpen         'offener Kopf
'        msoArrowheadStealth      'hinten spitz
'        msoArrowheadTriangle     'dreieckig
'______________________________________________________________________________________
On Error GoTo errHandler1 'Fehler abfangen
'derzeitig bekannt:
' # Spalten/Zeilenweise Markierung
' # wenn Pfeile bereits gelöscht
'alte löschen
ActiveSheet.Shapes("crossx").Delete
ActiveSheet.Shapes("crossy").Delete
errHandler1:
'entweder weiter die Fehler behandeln und ausgeben oder einfach nix weiter machen :)
On Error GoTo errHandler2 'Fehler abfangen
'aktive Zelle merken
xx = ActiveCell.Column
yy = ActiveCell.Row
x = 0
y = 0
For i = 1 To Cells(yy, xx).Column - 1
x = x + Cells(1, i).Width
Next i
For i = 1 To Cells(yy, xx).Row - 1
y = y + Cells(i, 1).Height
Next i
'Zeichnen - waagerecht
ActiveSheet.Shapes.AddLine(0, y + Cells(yy, xx).Height / 2, x, y + Cells(yy, xx).Height / 2).  _
_
_
Select
With Selection.ShapeRange.Line
.Weight = wght
.DashStyle = DS
.ForeColor.SchemeColor = FC
.BackColor.RGB = RGB(BCr, BCg, BCb)
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadLength = EAL
.EndArrowheadWidth = EAW
.EndArrowheadStyle = EAS
End With
Selection.Name = "crossx"
'zeichnen - senkrecht
ActiveSheet.Shapes.AddLine(x + Cells(yy, xx).Width / 2, 0, x + Cells(yy, xx).Width / 2, y). _
Select
With Selection.ShapeRange.Line
.Weight = wght
.DashStyle = DS
.ForeColor.SchemeColor = FC
.BackColor.RGB = RGB(BCr, BCg, BCb)
.BeginArrowheadStyle = msoArrowheadNone
.EndArrowheadLength = EAL
.EndArrowheadWidth = EAW
.EndArrowheadStyle = EAS
End With
Selection.Name = "crossy"
'alte Markierung wiederherstellen
Cells(yy, xx).Select
errHandler2:
'entweder weiter die Fehler behandeln und ausgeben oder einfach nix weiter machen :)
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Code mit Button ein und ausschalten
14.08.2019 11:11:33
Krogi
alternativ sonst auch gerne per Doppelklick- Funktion...
AW: VBA Code mit Button ein und ausschalten
14.08.2019 11:38:09
peterk
Hallo
Schreib folgenden Code isn gleiche Modul
Public useShape As Boolean

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  useShape = Not useShape
  Cancel = True
  Call Worksheet_SelectionChange(Target)
End Sub

Und füge folgende Zeile in den bestehende Code ein:
errHandler1:

 If Not useShape Then Exit Sub ' Diese Zeile einfügen !!!!! 
 
'entweder weiter die Fehler behandeln und ausgeben oder einfach nix weiter machen :) 
  On Error GoTo errHandler2 'Fehler abfangen 

Anzeige
AW: VBA Code mit Button ein und ausschalten
14.08.2019 11:57:09
Krogi
Danke für die schnelle Antwort.
Den den oberen Code konnte ich in das gleiche Modul einfügen.
Beim unteren Code bekomme ich die Fehlermeldung:
"Fehler beim Kompilieren: Mehrfachdeklaration im aktuellen Gültigkeitsbereich"
AW: VBA Code mit Button ein und ausschalten
14.08.2019 12:04:28
peterk
Hallo
Nur die Zeile die ich markiert habe darfst Du einfügen, den Rest habe ich nur mitkopiert damit Du die genaue Stelle siehst!
AW: VBA Code mit Button ein und ausschalten
14.08.2019 12:09:10
Krogi
Lesen muss man können...
Vielen Dank für deine Hilfe - funktioniert perfekt!! :-)

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige