ich bin neu hier und habe leider kaum VBA Kenntnisse. Versuche aber zu verstehen.
Ich habe mir die Zip Datei
https://www.herber.de/forum/archiv/1156to1160/1158311_Daten_in_geschlossene_externe_Tabelle_VBA.html
(vielen Dank dem Programmierer) so an meine Anforderungen angepasst, das alles gut funktioniert. Kann Daten erfassen und in andere Tabelle exportieren
Wenn mir jetzt jemand helfen könnte. Ich benötige bei klick im Kalender auf "Okay"
Private Sub cmdOK_Click(),
daß das Datum in der Tabelle "Bearbeitung" immer in der Zelle A1 ausgegeben wird. Zur Zeit wird _
_
es mal hier mal da ausgegeben.
Leider fehlt mir jedwede Kenntniss den Code so anzupassen.
Momentan sieht das so aus.
Private Sub cmdOK_Click()
Dim iLabel As Integer
For iLabel = 9 To 50
If Controls("Label" & iLabel).BorderStyle = 1 Then
Call SetDate(DateSerial(CInt(cboYears.Value), cboMonths.ListIndex + 1, CInt(Controls(" _
_
Label" & iLabel).Caption)))
Exit For
End If
Next iLabel
Unload Me
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub Label13_Click()
Label13.BorderStyle = fmBorderStyleSingle
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Label36_Click()
End Sub
Private Sub UserForm_Initialize()
Dim rng As Range
Dim datAct As Date
Dim vCaller As Variant, arr As Variant
Dim iCounter As Integer
vCaller = Application.Caller
If IsError(vCaller) Then
Set rng = ActiveCell
Else
Set rng = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, -1)
End If
If Not IsEmpty(rng) Then
datAct = rng.Value
Else
datAct = Date
End If
arr = Array("Mo", "Di", "Mi", "Do", "Fr", "Sa", "So")
For iCounter = 2 To 8
Controls("Label" & iCounter).Caption = arr(iCounter - 2)
Next iCounter
For iCounter = 1 To 12
cboMonths.AddItem Format(DateSerial(1, iCounter, 1), "mmmm")
Next iCounter
cboMonths.ListIndex = Month(datAct) - 1
For iCounter = 1900 To 2100
cboYears.AddItem iCounter
Next iCounter
cboYears.Value = Year(Date)
For iCounter = 9 To 50
Set Labels(iCounter).LabelGroup = frmCalendar.Controls("Label" & iCounter)
Next iCounter
End Sub
Private Sub SetFormValues()
Dim rng As Range
Dim datAct As Date
Dim vCaller As Variant
Dim lDay As Long
Dim iLabel As Integer, iCounter As Integer, iDay As Integer
Dim sDay As String
If cboYears.Value = "" Then Exit Sub
vCaller = Application.Caller
If IsError(vCaller) Then
Set rng = ActiveCell
Else
Set rng = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, -1)
End If
If Not IsEmpty(rng) Then
datAct = rng.Value
Else
datAct = Date
End If
Controls("Label1").Caption = cboMonths.Value & " " & cboYears.Value
sDay = Format(DateSerial(cboYears.Value, cboMonths.ListIndex + 1, 1), "ddd")
For iLabel = 2 To 8
If Controls("Label" & iLabel).Caption = sDay Then Exit For
Next iLabel
iLabel = iLabel + 7
For iDay = 9 To 50
With Controls("Label" & iDay)
.Caption = ""
.BorderStyle = 0
.BackColor = &H8000000F
End With
Next iDay
For lDay = DateSerial(cboYears.Value, cboMonths.ListIndex + 1, 1) To DateSerial(cboYears. _
Value, cboMonths.ListIndex + 2, 0)
iCounter = iCounter + 1
Controls("Label" & iLabel).Caption = iCounter
If CInt(cboYears.Value) = Year(datAct) And cboMonths.ListIndex + 1 = Month(datAct) And _
CInt(Controls("Label" & iLabel).Caption) = Day(datAct) Then
With Controls("Label" & iLabel)
.BorderStyle = 1
.ForeColor = &H80000012
.BackColor = &H8000000F
End With
End If
iLabel = iLabel + 1
Next lDay
End Sub
Vielen Dank.
Ich nutze Foren selten, kenne mich deshalb mit den Gepflogenheiten nicht so aus.
Vielen Dank im voraus. Andre