Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1380to1384
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
Inhaltsverzeichnis

Ausgabe Kalender

Ausgabe Kalender
28.09.2014 20:10:24
Andre
Guten Abend liebe Wissenden,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ausgabe Kalender
29.09.2014 10:16:28
fcs
Hallo Andre,
irgendwo in deinem VBA-Projekt muss es noch eine Sub mit Namen "SetDate" geben.
Diese trägt das Datum irgendwo ein, vermutlich in die gerade aktive Zelle im aktiven Tabellenblatt.
Du hast jetzt mehrere Möglichkeiten, u.a.:
1. Vor der Anzeige des Kalenders/Auswahl des Datums aktivierst du das Blatt "Bearbeitung" und selektierst die Zelle "A1"
Sheets("Bearbeitung").Activate
Range("A2").Select
2. Anpassung des Makros
Private Sub cmdOK_Click()
Dim iLabel As Integer
For iLabel = 9 To 50
If Controls("Label" & iLabel).BorderStyle = 1 Then
Worksheets("Bearbeitung").Range("A1").Value = DateSerial(CInt(cboYears.Value), _
cboMonths.ListIndex + 1, CInt(Controls("Label " & iLabel).Caption))
Exit For
End If
Next iLabel
Unload Me
End Sub
Gruß
Franz

Anzeige
AW: Ausgabe Kalender
29.09.2014 10:26:32
yummi
Hallo Andre,
du musst in module1 das folgende ändern:

Sub SetDate(myDat As Date)
'If Not ActiveCell Is Nothing Then ActiveCell.Value = myDat
ActiveSheet.Cells(1, 1).Value = myDat
End Sub
Dann schrteibt er das Datum nicht in die Aktive Zelle sondern immer in A1 (achte darauf, dass die Schriftfarbe der Zelle nicht gleich dem Hintergrund ist, wenn du was sehen willst.
Gruß
yummi

AW: Ausgabe Kalender
29.09.2014 19:42:42
Andre
Hallo Yummi,
vielen Dank für diesen Tip. Genau so funktioniert es.
Lg Andre...und einen schönen Abend

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige