Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1208to1212
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

Code im Klassemodul, Tabelle Übergreifend

Code im Klassemodul, Tabelle Übergreifend
Karel
Hallo Forum,
Im unterstehende Code vom Tino die tadellos funktioniert werden Change Ereignis die im Klassemodul stehen für Tabelle 1 ausgeführt.
Meine Frage, wie kann man diese Code für mehrere Tabelle definieren und oder für komplette Arbeitsmappe code. Habs unterander probiert mit 'Set WS_Events.Event_WS = ActiveSheet aber ohne erfolg.
***DieseArbeitmappe***
Option Explicit
Private Sub Workbook_Open()
Set WS_Events.Event_WS = Tabelle1
'Set WS_Events.Event_WS = ActiveSheet
End Sub
***Klassemodul diese Code****
Option Explicit
Public WithEvents Event_WS As Worksheet

Private Sub Event_WS_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strOrdner As String
If Target.Address  "$B$1" Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
Cancel = True
Target = .SelectedItems(1)
End If
End With
End Sub
Private Sub Event_WS_Change(ByVal Target As Range)
Dim rngCell As Range
If Intersect(Target, Range("C6:C999")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rngCell In Intersect(Target, Range("C6:C999"))
If Len(rngCell) Then
With rngCell.Offset(, -2).Resize(1, 7)
With .Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Target.Interior.Color = RGB(216, 216, 216)
Else
With rngCell.Offset(, -2).Resize(1, 7).Borders
.LineStyle = xlNone
End With
Target.Interior.ColorIndex = xlNone
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

beispiel
https://www.herber.de/bbs/user/74265.xlsm
Grüße
Karel

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Code im Klassemodul, Tabelle Übergreifend
04.04.2011 17:37:49
Nepumuk
Hallo,
für alle Tabellen? Na einfach im Modul "DieseArbeitsmappe":
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
End Sub

Gruß
Nepumuk
Anzeige
AW: Code im Klassemodul, Tabelle Übergreifend
04.04.2011 17:45:11
Tino
Hallo,
das geht so. (WS_Events war noch in einem Modul deklariert)
kommt als Code in DieseArbeitsmappe
Option Explicit 
 
'Beispiel für zwei Tabellen 
'Array mit zwei Datenfelder 0=1; 1=2; 2=3 usw... 
'Feld 1 = die erste Tabelle zuweisen 
'Feld 2 = die zweite Tabelle zuweisen 
 
Dim ArrayWorksheetEvents() As New Klasse1 
 
Private Sub Workbook_Open() 
Redim Preserve ArrayWorksheetEvents(1) 
 
Set ArrayWorksheetEvents(0).Event_WS = Tabelle1 
Set ArrayWorksheetEvents(1).Event_WS = Tabelle3 
End Sub 
 
 
kommt als Code in Klasse1
Option Explicit 
 
Public WithEvents Event_WS As Worksheet 
 
Private Sub Event_WS_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    Dim strOrdner As String 
    If Target.Address <> "$B$1" Then Exit Sub 
     
    Cancel = True 
     
    With Application.FileDialog(msoFileDialogFolderPicker) 
        .InitialFileName = "C:\" 
        .Title = "Ordnerauswahl" 
        .ButtonName = "Auswahl..." 
        .InitialView = msoFileDialogViewList 
        If .Show = -1 Then 
            Cancel = True 
            Target = .SelectedItems(1) 
        End If 
    End With 
End Sub 
 
Private Sub Event_WS_Change(ByVal Target As Range) 
Dim rngCell As Range 
  
 If Intersect(Target, Range("C6:C999")) Is Nothing Then Exit Sub 
 Application.ScreenUpdating = False 
 Application.EnableEvents = False 
  
 For Each rngCell In Intersect(Target, Range("C6:C999")) 
         If Len(rngCell) Then 
         With rngCell.Offset(, -2).Resize(1, 7) 
          With .Borders 
          .LineStyle = xlContinuous 
          .Weight = xlMedium 
          .ColorIndex = xlAutomatic 
          End With 
          .Borders(xlDiagonalDown).LineStyle = xlNone 
          .Borders(xlDiagonalUp).LineStyle = xlNone 
         End With 
         Target.Interior.Color = RGB(216, 216, 216) 
          
         Else 
         With rngCell.Offset(, -2).Resize(1, 7).Borders 
         .LineStyle = xlNone 
         End With 
         Target.Interior.ColorIndex = xlNone 
         End If 
 Next 
  
 Application.ScreenUpdating = True 
 Application.EnableEvents = True 
End Sub 

Du kannst auch in DieserArbeitsmappe entsprechende Event Makros erstellen.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

End Sub
Sh steht für die Tabelle.
Nachteil, dieser Code startet in jeder Tabelle dieser Mappe und muss evtl. mittels Code
entsprechend abgefangen werden.
Gruß Tino
Anzeige
AW: Code im Klassemodul, Tabelle Übergreifend
05.04.2011 11:06:30
Karel
Hallo Tino,
Habe deine erste code genommen, damit kann ich wunderbar die definierte Tabelle die nötig sind, perfekt mit ansteuern.
Vielen dank für deine Lösungs ansatz
Grüße
Karel

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige