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