Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
920to924
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
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Mehrere Makros für eine Tabelle

Mehrere Makros für eine Tabelle
05.11.2007 22:11:00
Urs
Guten Abend an alle!
Wer kann mir sagen, wie sich folgende Makros und Module vom Code her zusammenfassen/verknüpfen lassen. Beide sollen für ein- und dieselbe Tabelle gelten:
Makro 1 (Kalenderfunktion):
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Kalenderaufruf
If Target.Column = 5 Or Target.Column = 11 Then
Call OpenCalendar
End If
End Sub



Private Sub Worksheet_Activate()
Range("A3000").End(xlUp).Offset(1, 0).Select
End Sub


Makro 2 (Adressen):
Option Explicit
Private Zelle As Range 'Variable zum Merken des Addresse der selektierten Zelle


Private Sub ComboBox1_Change()
Dim Zeile As Long
'Aktionen nach Wertänderung der ComboBox
On Error GoTo Fehler
Application.EnableEvents = False
Zeile = Zelle.Row
If Me.ComboBox1.Value = "" Then
Zelle.ClearContents
Zelle.Select
'Formeln in Spalten T bis Z löschen
Range(Cells(Zeile, 20), Cells(Zeile, 26)).ClearContents
Else
If Not IsNull(Me.ComboBox1.Value) Then
'KundenNr (Text aus Combobox wird in Zahl umgewandelt)
Cells(Zeile, 19).Value = Val(Me.ComboBox1.Value)
'Formeln in Spalten T bis Z eintragen
Cells(Zeile, 20).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-1],Auswahlliste,2,FALSE)=0,"""",VLOOKUP(RC[-1],Auswahlliste,2,FALSE))" 'Nr. _
_
Cells(Zeile, 21).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-2],Auswahlliste,3,FALSE)=0,"""",VLOOKUP(RC[-2],Auswahlliste,3,FALSE))" ' _
Zusatz
Cells(Zeile, 22).FormulaR1C1 = "=VLOOKUP(RC[-3],Auswahlliste,5,FALSE)" 'Name 1
Cells(Zeile, 23).FormulaR1C1 = _
"=IF(VLOOKUP(RC[-4],Auswahlliste,6,FALSE)=0,"""",VLOOKUP(RC[-4],Auswahlliste,6,FALSE))" ' _
Name2
Cells(Zeile, 24).FormulaR1C1 = "=VLOOKUP(RC[-5],Auswahlliste,7,FALSE)" 'Strasse
Cells(Zeile, 25).FormulaR1C1 = "=VLOOKUP(RC[-6],Auswahlliste,8,FALSE)" 'PLZ
Cells(Zeile, 26).FormulaR1C1 = "=VLOOKUP(RC[-7],Auswahlliste,9,FALSE)" 'Ort
End If
End If
GoTo Beenden
Fehler:
If Err.Number = 91 Then
MsgBox "Bitte selektieren Sie zunächst eine andere Zelle!" & vbLf & _
"Diese Meldung erscheint nach dem Öffnen der Datei, wenn in der angezeigten " & _
"ComboBox direkt der Wert geändert wird ohne vorher eine andere Zelle zu selektieren."
Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
End If
Beenden:
Application.EnableEvents = True
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
'Auf Spalte mit Kundennummer prüfen
If Target.Column = 19 And Target.Row > 1 And Target.Cells.Count = 1 Then
Set Zelle = Target
Me.ComboBox1.Value = Target.Value
End If
GoTo Beenden
Fehler:
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
Beenden:
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error GoTo Fehler
With Me.ComboBox1
'Auf Spalte mit Kundennummer prüfen
If Target.Column = 19 And Target.Row > 1 And Target.Cells.Count = 1 Then
Application.EnableEvents = False
Set Zelle = Target
.Value = Target.Value
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.Visible = True
Application.EnableEvents = True
Else
Set Zelle = Nothing
.Visible = False
End If
End With
GoTo Beenden
Fehler:
MsgBox "Fehler Nr. " & Err.Number & " ist aufgtreten!" & vbLf & vbLf & Err.Description
Beenden:
Application.EnableEvents = True
End Sub


Die Module lauten folgendermaßen:
Modul 1 (Kalender):
Option Explicit
Sub OpenCalendar()
' Displays the UserForm and calendar
' Shortcuts should be made to this procedure
frmCalendar.Show
End Sub


Sub Reset()
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Modul 2 (Adressen):
Option Explicit
Sub EventsAktivieren()
Application.EnableEvents = True
End Sub


Sub EventsDeAktivieren()
Application.EnableEvents = False
End Sub


Vielen Dank für Eure Hilfe.
Urs

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Makros für eine Tabelle
07.11.2007 09:42:00
Wolli
Hallo Urs, anscheinend hat bisher keiner die Muße gehabt, deinen ganzen Code durchzulesen, auch ich nicht. Nur so viel in Kürze: Pro Blatt darf es jede Ereignisprozedur nur einmal geben. Wenn Du zwei (oder mehr) hast, musst Du sie zusammenpacken, indem Du je nach Ereignisdetail (z.B. Target.Address oder so) eine if ... then ... else-Entscheidung oder ähnliches machst.
Bitte frag nochmal konkret nach, wenn's noch Probleme gibt.
Gruß, Wolli
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige