aktuelles Datum in Spalte finden
02.12.2020 08:13:39
Marco
ich versuche schon länger, den Code passend in meine Module einzubauen und hoffe nun, dass jemand hier im Forum eine Lösung hat.
Es geht um einen Kalender der mehrere Jahre abbildet. Jedes Jahr ist in einem eigenen Sheet untergebracht. Name z.B.: "Kalender 2020"; "Kalender 2021"; usw..
Folgender Code AktuellesDatumFinden()) funktioniert, jedoch nur bis der Code SpinButton1_SpinDown() unten ausgeführt wurde. dann Stoppt er bei jedem Set mit der Notiz: Fehler-Nr.: 91, Objektvariable oder With-Blockvariable nicht festgelegt. Ich habe schon alles mir bekannte oder aus dem Netz gefundene versucht. Das auskommentierte im folgenden Code war auch ein Versuch von mir, der solange funktioniert, bis der Code SpinButton1_SpinDown() ausgeführt wurde.
Viele Grüße Marco
Sub AktuellesDatumFinden()
On Error GoTo Fehlermeldung
If InStr(ActiveSheet.Name, "Kalender " & Year(Date)) Then
Anfang:
Dim ws As Worksheet
Dim r As Range
Set ws = ActiveSheet
'Set r = Cells.Find(Date) Privat Sub SpinButton1_SpinDown()
'ausgewählter Name aus Listbox in Tabelle verschieben nach rechts
Application.ScreenUpdating = False
If ListBoxVorhandenePersonen.ListIndex = -1 Then
MsgBox "Bitte Mitarbeiter auswählen", vbCritical, "Kein Eintrag in Listbox ausgewählt..."
Exit Sub
End If
'Wenn der letzte Eintrag nach unten verschoben werden soll
If ListBoxVorhandenePersonen.ListIndex = ListBoxVorhandenePersonen.ListCount - 1 Then
MsgBox "Der aktuelle und letzte Eintrag: " & Chr(10) & Chr(10) & ListBoxVorhandenePersonen. _
_
Value & Chr(10) & Chr(10) & " Kann nicht weiter nach unten verschoben werden!", vbCritical, " _
Kein Eintrag in Listbox ausgewählt..."
Exit Sub
End If
'Verschiebebereich definieren
Dim letzteSpalte As Long
Dim letzteZeile As Long
'Hier wird die letzte Spalte der Zeile 2 ermittelt
letzteSpalte = ActiveSheet.Cells(2, 48).End(xlToLeft).Column
letzteZeile = ActiveSheet.Cells(500, 2).End(xlUp).Row
'Suchwort festlegen
Dim NamenSpalte As Range
Dim NamensSpeicher As String
Dim rng As Range
With ActiveSheet.Range("D2:AU2")
Set rng = .Find(ListBoxVorhandenePersonen.Value, LookIn:=xlValues)
End With
NamensSpeicher = rng
If Not rng Is Nothing Then
' MsgBox rng.Column
' Cells(1, rng.Column).Select
'und Spalte markieren
Range(Cells(1, rng.Column), Cells(letzteZeile, rng.Column)).Select
'Spalte nach rechts verschieben
'Range(Cells(1, rng.Column), Cells(letzteZeile, rng.Column))
Dim vntReturn As Variant
vntReturn = rng.Column
Columns(vntReturn).Cut
Columns(ActiveCell.Column + 1).Select
Columns(ActiveCell.Column + 1).Insert Shift:=xlRight
End If
'Listbox aktualisieren
Call ListboxMitarbeiterAktualisieren
'verschobenen Namen wieder markeiren
ListBoxVorhandenePersonen.Value = NamensSpeicher
Set rng = Nothing
NamensSpeicher = ""
Application.ScreenUpdating = True
End Sub