Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Ausgabe Kalender

Betrifft: Ausgabe Kalender von: Andre
Geschrieben am: 28.09.2014 20:10:24

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

  

Betrifft: AW: Ausgabe Kalender von: fcs
Geschrieben am: 29.09.2014 10:16:28

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


  

Betrifft: AW: Ausgabe Kalender von: yummi
Geschrieben am: 29.09.2014 10:26:32

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


  

Betrifft: AW: Ausgabe Kalender von: Andre
Geschrieben am: 29.09.2014 19:42:42

Hallo Yummi,

vielen Dank für diesen Tip. Genau so funktioniert es.


Lg Andre...und einen schönen Abend


 

Beiträge aus den Excel-Beispielen zum Thema "Ausgabe Kalender"