Anzeige
Archiv - Navigation
1368to1372
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

Ferienplan mit VBA

Ferienplan mit VBA
14.07.2014 11:13:16
Marc
Guten Morgen Forumsmitglieder
In der Hoffnung, dass sich alle von den gestrigen Feierlichkeiten erholt haben, wende ich mich an euch mit einer VBA-Frage.
Und zwar habe ich einen Ferienplan für eine Abteilung erstellt. In diesem sind die Namen der Teammitlieder jeweils in der Spalte B eingetragen. Für jedes Quartal gibt es ein eigenes Tabellenblatt.
Nun habe ich zwei Userforms für die Eintragung von Abwesenheiten erstellt. Die eine für die ersten beiden Quartale und die andere für die letzten beide. Diese Userform sieht folgendermassen aus:
Userbild
Die Mitarbeiter in der ComboBox für die Auswahl des Mitarbeiters habe ich mittels Namenmanager flexibel gestaltet. Dass heisst, wenn ein Mitarbeiter gelöscht wird, taucht dieser nicht mehr in der Combobox auf. Hingegen wenn ein neuer hinzugefügt wird, ist dieser auch in der Combobox ersichtlich. Dasselbe gilt für die ComboBox mit den Absenzgründen. Ich habe hierfür folgenden Code verwendet:
  • 
    Private Sub UserForm_Initialize()
    Dim rngAbsenzgründe As Range
    Dim rngMitarbeiter As Range
    'Werte für ComboBoxen von Excel beziehen
    With Me
    .cboEingabeAbsenzgrundJul.List = Range("Absenzgründe").Value
    .cboEingabeMitarbeiterJul.List = Range("MitarbeiterJulAugSep").Value
    .cboEingabeAbsenzgrundAug.List = Range("Absenzgründe").Value
    .cboEingabeMitarbeiterAug.List = Range("MitarbeiterJulAugSep").Value
    .cboEingabeAbsenzgrundSep.List = Range("Absenzgründe").Value
    .cboEingabeMitarbeiterSep.List = Range("MitarbeiterJulAugSep").Value
    .cboEingabeAbsenzgrundOkt.List = Range("Absenzgründe").Value
    .cboEingabeMitarbeiterOkt.List = Range("MitarbeiterOktNovDez").Value
    .cboEingabeAbsenzgrundNov.List = Range("Absenzgründe").Value
    .cboEingabeMitarbeiterNov.List = Range("MitarbeiterOktNovDez").Value
    .cboEingabeAbsenzgrundDez.List = Range("Absenzgründe").Value
    .cboEingabeMitarbeiterDez.List = Range("MitarbeiterOktNovDez").Value
    End With
    End Sub
    

  • Dass korrekte Datum für die Abwesenheiten soll nun über das Auswählen der Checkboxen im Kalender wiedergegeben werden. Hierzu kann ich ja glaube ich die Ausgabe der Checkboxen mit den jeweiligen Zellen in welchen die Daten stehen verknüpfen. Also quasi wenn der 3. Juli ausgewählt wird, die Spalte in welcher der 3. Juli steht hinterlegen.
    Leider schaffe ich es nun aber nicht, die Daten korrekt in den Ferienplänen wiederzugeben. Dass heisst, wenn ein Mitarbeiter ausgewählt wird in der Userform, schaffe ich es nicht, dass die korrekte Zeile angesprochen wird. Auch die Daten in den Spalten sind noch nicht verknüpft. Wie schaffe ich es, dass die Daten korrekt ausgegeben werden?
    Zudem muss ja der Absenzgrund schlussendlich im Ferienplan eingetragen werden. Jedoch ist dieser zu lang und ich habe für jeden Grund einen Code definiert. Z.B. wenn Urlaub ausgewählt wird muss im Kalender der Code U wiedergegeben werden. Auch dies schaffe ich nicht.
    Ich hoffe ihr könnt mir weiterhelfen. Sitze nun seit circa einer Woche an dieser Programmierung und drehe langsam aber sicher durch, weil ich nicht weiterkomme. Zudem besteht, dass Problem, dass ich das Programmieren generell nicht wirklich verstehe und von daher schon gar keine gescheiten Ansatz habe.
    Hier ist noch der Link für die Beispieldatei:
    https://www.herber.de/bbs/user/91497.xlsm
    Ich möchte mich bereits im Voraus für eure Bemühungen bedanken.
    LG Marc

    1
    Beitrag zum Forumthread
    Beitrag zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Ferienplan mit VBA
    14.07.2014 17:10:27
    fcs
    Hallo Marc,
    das Ganze ist ziemlich komplex und der Aufbau der Tabelle macht es nicht leichter.
    1. Comboxen für die Namenslisten
    Da du mit verbundenen Zellen und nicht benutzen Zeilen für die Auswahlliste arbeitest kann man aus dem Listindex des gewählten Eintrags nicht auf die Zeilennummer in der Tabelle schließen.
    Bei mir funktioniert die Auswahlliste für die Namen übrigens nicht - es wird nur der 1. Name angezeigt.
    Damit die Zeile eines ausgewählten Namens ermittelt werden kann muss man entweder mit einer Suchfunktion arbeiten oder die Zeilen zu den Namen werden in einer 2. Spalte der Combobox eingetragen und können dann über List- und Listindex-Eigenschaft der Combobox ermittelt werden. Ich hab den letzteren Weg in der Initialiserungsprozedur eingebaut.
    2. Spalte zu markierten Checkboxen ermitteln.
    Hier muss man in 2 Stufen arbeiten:
    2a: Die Spalte mit dem 1. Tag des Monats wird ermittelt
    2b: Die Checkboxen des Monats werden in einer Schleife abgearbeitet. Wenn "True", dann kann aus der Zählnummer der Textbox die Spalte im Tabellenblatt ermittelt werden.
    Nachfolgend der angepasste/ergänzte Code für das Userform1. Damit man nicht für jeden Monat den Code wiederholen muss hab ich Sub-Rozinene erstellt, an die Monatsinformationen als Parameter von den Schaltflächen-Codes übergeben werden.
    Gruß
    Franz
    Function fncSpalteTag1(ByVal intMonat As Integer)
    'Ermittelt die Spalte des 1. Tages im Quartalsblatt für den angegebenen Monat
    Dim xte_1 As Integer, Spalte As Long, intCount As Integer
    Select Case intMonat
    Case 1, 4, 7, 10 '1. Monat im Quartal
    xte_1 = 1
    Case 2, 5, 8, 11 '2. Monat im Quartal
    xte_1 = 2
    Case 3, 6, 9, 12 '3. Monat im Quartal
    xte_1 = 3
    End Select
    With ActiveSheet
    'in Zeile nach dem x-ten auftreten der 1 in einer Zelle suchen
    For Spalte = 4 To .Cells(6, .Columns.Count).End(xlToLeft).Column
    If .Cells(6, Spalte).Value = 1 Then
    intCount = intCount + 1
    If intCount = xte_1 Then
    fncSpalteTag1 = Spalte
    Exit For
    End If
    End If
    Next
    End With
    End Function
    Private Sub prcUebernehmenMonat(ByVal Zeile As Long, ByVal intMonat As Integer, _
    ByVal strMonat As String, intAbsenz As Integer)
    'Zeile = Zeile mit Mitarbeitername
    'intMonat = Nummer des Monats von 1 bis 12
    'strMonat = Name des Monats, wie er in den Namen der Checkboxen eingebaut ist
    'intAbsenz = Index-Nummer des gewählten Absenzgrundes
    Dim intTageMonat As Integer
    Dim intTag As Integer, Spalte As Long, Spalte_1 As Long
    Select Case intMonat
    Case 1, 3, 5, 7, 8, 10, 12
    intTageMonat = 31
    Case 2
    intTageMonat = 28
    'Schaltjahr - hier sind ggf. Anpassungen erforderlich, wenn Plan schon im Vorjahr  _
    ausgefüllt wird.
    If IsDate(Year(Date) & "-02-29") Then
    intTageMonat = 29
    End If
    Case 4, 6, 9, 11
    intTag = 30
    End Select
    'Spalte Tag 1 des Monats ermitteln/Festlegen
    Spalte_1 = fncSpalteTag1(intMonat:=intMonat) '1 = Januar
    For intTag = 1 To intTageMonat
    If Me.Controls("V" & Format(intTag, "0") & strMonat).Value = True Then
    Spalte = Spalte_1 + intTag - 1
    ActiveSheet.Cells(Zeile, Spalte).Value = _
    ActiveSheet.Range("Absenzgründe").Range("A1").Offset(intAbsenz, -1)
    End If
    If Me.Controls("N" & Format(intTag, "0") & strMonat).Value = True Then
    Spalte = Spalte_1 + intTag - 1
    ActiveSheet.Cells(Zeile + 1, Spalte).Value = _
    ActiveSheet.Range("Absenzgründe").Range("A1").Offset(intAbsenz, -1)
    End If
    Next
    End Sub
    Private Sub cmdUebernehmenJan_Click()
    If Me.cboEingabeMitarbeiterJan.ListIndex = -1 Then
    MsgBox "Bitte einen Mitarbeiternamen auswählen"
    Else
    If Me.cboEingabeAbsenzgrundJan.ListIndex = -1 Then
    MsgBox "Bitte einen Abstinenzgrund auswählen"
    Else
    With Me.cboEingabeMitarbeiterJan
    Call prcUebernehmenMonat(Zeile:=.List(.ListIndex, 1), intMonat:=1, strMonat:="Januar",  _
    _
    intAbsenz:=Me.cboEingabeAbsenzgrundJan.ListIndex)
    End With
    End If
    End If
    End Sub
    Private Sub cmdUebernehmenFeb_Click()
    If Me.cboEingabeMitarbeiterFeb.ListIndex = -1 Then
    MsgBox "Bitte einen Mitarbeiternamen auswählen"
    Else
    If Me.cboEingabeAbsenzgrundFeb.ListIndex = -1 Then
    MsgBox "Bitte einen Abstinenzgrund auswählen"
    Else
    With Me.cboEingabeMitarbeiterFeb
    Call prcUebernehmenMonat(Zeile:=.List(.ListIndex, 1), intMonat:=2, strMonat:="Februar",  _
    _
    intAbsenz:=Me.cboEingabeAbsenzgrundFeb.ListIndex)
    End With
    End If
    End If
    End Sub
    Private Sub cmdUebernehmenMärz_Click()
    If Me.cboEingabeAbsenzgrundMärz.ListIndex = -1 Then
    MsgBox "Bitte einen Mitarbeiternamen auswählen"
    Else
    If Me.cboEingabeAbsenzgrundMärz.ListIndex = -1 Then
    MsgBox "Bitte einen Abstinenzgrund auswählen"
    Else
    With Me.cboEingabeMitarbeiterMärz
    Call prcUebernehmenMonat(Zeile:=.List(.ListIndex, 1), intMonat:=2, strMonat:="März", _
    intAbsenz:=Me.cboEingabeAbsenzgrundMärz.ListIndex)
    End With
    End If
    End If
    End Sub
    Private Sub UserForm_Initialize()
    Dim rngAbsenzgründe As Range
    Dim rngMitarbeiter As Range
    Dim arrList(), intJ As Integer, wks As Worksheet, Zeile As Long, Zelle As Range
    'Werte für ComboBoxen von Excel beziehen
    Set wks = ActiveSheet
    'Namen und Zeilen-Nr. in Array einlesen, wenn in Spalte C ein "V" steht
    intJ = 0
    With wks
    For Zeile = 7 To .Cells(.Rows.Count, 3).End(xlUp).Row
    If Cells(Zeile, 3) = "V" Then
    intJ = intJ + 1
    ReDim Preserve arrList(1 To 2, 1 To intJ)
    arrList(1, intJ) = .Cells(Zeile, 2).Range("A1").Text
    arrList(2, intJ) = Zeile
    End If
    Next
    End With
    If intJ > 0 Then
    With Me
    .cboEingabeAbsenzgrundJan.List = Range("Absenzgründe").Value
    With .cboEingabeMitarbeiterJan
    .ColumnCount = 2
    .ColumnWidths = "150pt;0Pt"
    .Column = arrList
    End With
    .cboEingabeAbsenzgrundFeb.List = Range("Absenzgründe").Value
    With .cboEingabeMitarbeiterFeb
    .ColumnCount = 2
    .ColumnWidths = "150pt;0Pt"
    .Column = arrList
    End With
    .cboEingabeAbsenzgrundMärz.List = Range("Absenzgründe").Value
    With .cboEingabeMitarbeiterMärz
    .ColumnCount = 2
    .ColumnWidths = "150pt;0Pt"
    .Column = arrList
    End With
    End With
    Erase arrList
    End If
    End Sub
    

    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige