AW: sehe weder Tabelle1 noch Tabelle2
09.09.2020 15:34:38
Clark
Hallo JoWe
Das ist nur ein Teil des Codes.
Bin davon ausgegangen das dieser reichen würde weil ich dachte das ich nur diesen Code bzw. diese Zeile bearbeiten muss...
Set wkSh = ThisWorkbook.Worksheets("Tabelle1")
Hier ist der ganze Code...
Option Explicit
Private Sub cbo_year_Change()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_0_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_1_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_2_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_3_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_4_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_5_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_6_Click()
Me.lst_day.Clear
Call my_days
End Sub
Private Sub chk_all_Click()
Dim i As Integer
If Me.chk_all Then
For i = 0 To Me.lst_day.ListCount - 1
Me.lst_day.Selected(i) = True
Next
Else
For i = 0 To Me.lst_day.ListCount - 1
Me.lst_day.Selected(i) = False
Next
End If
End Sub
Private Sub chk_month_Click()
If Me.chk_month Then
Me.lst_month.MultiSelect = fmMultiSelectMulti
Me.cmd_akt.Enabled = True
Else
Me.lst_month.MultiSelect = fmMultiSelectSingle
Me.cmd_akt.Enabled = False
End If
End Sub
Private Sub cmd_abr_Click()
Unload Me
End Sub
Private Sub cmd_akt_Click()
Dim i As Integer
Me.lst_day.Clear
Call my_days
End Sub
Private Sub cmd_ok_Click()
Dim wkSh As Worksheet, rng As Range, _
mycheck As Integer, i As Integer
Set wkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
Set rng = wkSh.Range("C19:C32")
Range("C19:C32").ClearContents
For i = 0 To Me.lst_day.ListCount - 1
If Me.lst_day.Selected(i) = True Then
mycheck = mycheck + 1
rng(mycheck, 1).Value = CDate(Left(Me.lst_day.List(i), 8))
End If
Next
If mycheck = 0 Then
MsgBox "bitte Tage wählen"
End If
End Sub
Private Sub lst_month_Click()
If Me.lst_month.ListIndex >= 0 Then
Me.lst_day.Clear
Call my_days
End If
End Sub
Private Sub UserForm_Activate()
Dim i As Integer
If TypeOf Selection Is Range Then
For i = 1 To 24
Me.lst_month.AddItem Format(DateSerial(1900, i, 1), "mmmm")
Me.cbo_year.AddItem Year(Date) - 3 + i
Next
Me.cbo_year.ListIndex = 1
Me.lst_month.ListIndex = Month(Date) - 1
Else
MsgBox "bitte zuerst Zielzelle wählen"
Unload Me
End If
End Sub
Sub my_days()
Dim i As Integer, last_day As Long
Dim int_day As Integer, int_Week As Integer, str_F As String, str_chek As String, obj_chkthis As Object
Me.chk_all.Value = False
For i = 0 To Me.lst_month.ListCount - 1
If Me.lst_month.Selected(i) = True Then
str_chek = fCheck
last_day = fday(i)
For int_day = 1 To last_day
For int_Week = 1 To Len(str_chek)
If DateSerial(CInt(Me.cbo_year.Value), i + 1, int_day) Mod 7 = CInt(Mid(str_chek, int_Week, 1)) Then
Set obj_chkthis = Sheets(2).Columns(1).Find(CLng(DateSerial(CInt(Me.cbo_year.Value), i + 1, int_day)), lookat:=xlWhole)
If Not obj_chkthis Is Nothing Then
str_F = " FTag"
Else
str_F = ""
End If
Set obj_chkthis = Nothing
Me.lst_day.AddItem Format(DateSerial(CInt(Me.cbo_year.Value), i + 1, int_day), "dd.mm.yy ddd") & str_F
End If
Next
Next
End If
Next
End Sub
Function fday(mymonth As Integer) As Long
fday = Day(DateSerial(CInt(Me.cbo_year.Value), mymonth + 2, 0))
End Function
Function fCheck() As String
Dim i As Integer
For i = 0 To 6
If Controls("chk_" & i).Value = True Then
fCheck = fCheck & i
End If
Next
If fCheck = "" Then fCheck = "0123456"
End Function