Ajout d'un case a cocher

ploz · 19 Janvier 2016

Bonjour a tous,

je le tourne vers vous car j'ai un petit soucis

voila je vous explique mon soucis j'ai un fichier excel pour tenir un planning:
j'ai un onglet absence qui a l'interieur contient un bouton de demande d'absence des qu on clique sur ce bouton on indique la date de debut date de fin, on choisi l'opérateur concerné, et on coche le choix si c'est cp RTT ect ...
et si on valide celui ci se reporte dans la feuille planning ou j'ai tout mes opérateurs

j'ai une fonction assez spécial si l'opérateur decide de partir avant en cochant HR- celui ci calcul automatiquement le temps de présence en fonction du nombre de hr- entré dans le formulaire

cependant je voudrais que celui ci fonctionne pour le SansSoldes

Code:

 oSh.Cells(iLig, Colonne - 1).Value = IIf(Me.Frame2.Visible = True, Val(Replace(Me.TextBox1, ",", ".")), 1)
      NbHeure = NbHeure + oSh.Cells(iLig, Colonne - 1).Value
      oSh.Cells(iLig, Colonne).Value = Choix
      Select Case UCase(Choix)
        Case "CP", "RTTC", "RTTI", "MAL", "ATT", "CF", "AT", "CET", "PAT", "FERIE"
          oSh.Cells(iLig, Colonne - 2).ClearContents
        Case "HR-", "SANSSOLDES"
          If oSh.Cells(iLig, Colonne - 1) >= 3.5 Then EnPlus = 0.5
          oSh.Cells(iLig, Colonne - 2) = oSh.Cells(iLig, Colonne - 2) - oSh.Cells(iLig, Colonne - 1) - EnPlus
      End Select
    End If
  Next iLig

j'ai ajouté ce bout de code, Case "HR-", "SANSSOLDES" il me l'inscrit bien dans ma feuille mais me fait pas le calcul pour le sans soldes alors que le hr- fonctionne bien

merci pour votre aide

ploz · 20 Janvier 2016

Re : Ajout d'un case a cocher

personne pour me venir en aide ?

JCGL · 20 Janvier 2016

Re : Ajout d'un case a cocher

Bonjour à tous,

Et si joignais un bout de fichier ?

A+ à tous

ploz · 20 Janvier 2016

Re : Ajout d'un case a cocher

Bonsoir,

merci de ta réponse

voici le code qui se trouve dans le module demandedabsence

Code:

Option Explicit

Sub essai()
 F_calendrier2dates.Show 0
End Sub

Sub ListeDemandeAbsence()
Dim Colonne As Integer, Nblg As Long, Ligne As Long, Cel As Range, Depart As String
Dim Motif As String, DateDeb As Date, DateFin As Date
Dim LgRecopie As Long, Absence As Double

  If MsgBox("Voulez-vous recalculer toutes les absences ?", vbInformation + vbYesNo + vbDefaultButton2, "Liste des absences") <> vbYes Then Exit Sub
  Sheets("Demande d'absence").Cells.ClearContents
  LgRecopie = 2
  With Sheets("Planning")
    Nblg = .Range("B" & Rows.Count).End(xlUp).Row
    Set Cel = .Rows(19).Find(what:="*", LookIn:=xlValues, lookat:=xlWhole)
    If Not Cel Is Nothing Then
      Depart = Cel.Address
      Do
        If Cel.Column > 4 And Trim(Cel) <> "" Then
          Colonne = Cel.Column + 2
          Motif = "": DateDeb = 0: Absence = 0
          For Ligne = 21 To Nblg
            If UCase(.Cells(Ligne, Colonne)) <> "RTT" And UCase(.Cells(Ligne, Colonne)) <> "HR+" And Trim(.Cells(Ligne, Colonne)) <> "" Then
              If Motif <> .Cells(Ligne, Colonne) Then
                If DateDeb = 0 Then
                  Motif = .Cells(Ligne, Colonne)
                  DateDeb = .Range("B" & Ligne)
                  DateFin = .Range("B" & Ligne)
                  Absence = Val(Trim(Replace(.Cells(Ligne, Colonne - 1), ",", ".")))
                Else
                  With Sheets("Demande d'absence")
                    .Range("A" & LgRecopie) = Cel
                    .Range("B" & LgRecopie) = DateDeb
                    .Range("C" & LgRecopie) = DateFin
                    .Range("D" & LgRecopie) = Motif
                    .Range("E" & LgRecopie) = Absence
                    '.Range("F" & LgRecopie) = Colonne
                  End With
                  LgRecopie = LgRecopie + 1
                  Motif = "": DateDeb = 0: Absence = 0
                End If
              Else
                DateFin = .Range("B" & Ligne)
                Absence = Absence + Val(Trim(Replace(.Cells(Ligne, Colonne - 1), ",", ".")))
              End If
            Else
              If Motif <> "" Then
                With Sheets("Demande d'absence")
                  .Range("A" & LgRecopie) = Cel
                  .Range("B" & LgRecopie) = DateDeb
                  .Range("C" & LgRecopie) = DateFin
                  .Range("D" & LgRecopie) = Motif
                  .Range("E" & LgRecopie) = Absence
                  '.Range("F" & LgRecopie) = Colonne
                End With
                LgRecopie = LgRecopie + 1
                Motif = "": DateDeb = 0: Absence = 0
              End If
            End If
          Next Ligne
          'If Motif <> "" Then Stop
        End If
        'Stop
        Set Cel = .Rows(19).FindNext(Cel)
      Loop While Depart <> Cel.Address
    End If
  End With
  With Sheets("Demande d'absence")
    .Range("A1:E1") = Array("Operateur", "Du", "Au", "Choix", "Heure/jour")
    .Columns("A:E").AutoFit
  End With
  MsgBox "C'est fini"
End Sub

et voici le code qui se trouve dans F_calendrier2dates

Code:

Dim mois_courant
Dim témoin, Début, Fin
'V0.1
Private Enum E_TypeConges
  E_Aucun = 0
  E_CP
  E_RTTC
  E_RTTI
  E_Maladie
  E_AT
  E_PAT
  E_SANSSOLDE
  E_HR
  E_ATT
  E_CF
  E_CET
  E_FERIE
  E_DEPLACEMENT
End Enum
'V0.1-fin

'V0.1
Private Sub Valider(pdtDeb As Date, pdtFin As Date, peType As E_TypeConges)
Dim Colonne As Integer
Dim oSh As Worksheet
Dim iLigFin As Integer
Dim iLig As Integer
Dim iLigDateDeb As Integer
Dim iLigDateFin As Integer
Dim dtJour As Date
Dim Ligne As Long, Choix As String
Dim NbHeure As Double, EnPlus As Double

  Set oSh = Worksheets("Planning")

  iLigDateDeb = -1
  iLigDateFin = -1
  iLigFin = oSh.Range("B" & Rows.Count).End(xlUp).Row

  For iLig = 21 To iLigFin
    If oSh.Range("B" & iLig).Value = pdtDeb Then
      iLigDateDeb = iLig
    End If
    If oSh.Range("B" & iLig).Value = pdtFin Then
      iLigDateFin = iLig
    End If
    If iLigDateDeb <> -1 And iLigDateFin <> -1 Then
      Exit For
    End If
  Next iLig

  If iLigDateDeb = -1 Then
    MsgBox "Date non trouvée : " & pdtDeb, vbExclamation
    Exit Sub
  End If

  If iLigDateFin = -1 Then
    MsgBox "Date non trouvée : " & pdtFin, vbExclamation
    Exit Sub
  End If

  If peType = E_CP Then
    Choix = "CP"
  ElseIf peType = E_Maladie Then
    Choix = "MAL"
  ElseIf peType = E_RTTC Then
    Choix = "RTTC"
  ElseIf peType = E_RTTI Then
    Choix = "RTTI"
  ElseIf peType = E_AT Then
    Choix = "AT"
  ElseIf peType = E_PAT Then
    Choix = "PAT"
  ElseIf peType = E_SANSSOLDE Then
    Choix = "SANS SOLDE"
  ElseIf peType = E_HR Then
    Choix = "HR-"
    ElseIf peType = E_ATT Then
    Choix = "ATT"
    ElseIf peType = E_CF Then
    Choix = "CF"
    ElseIf peType = E_CET Then
    Choix = "CET"
    ElseIf peType = E_FERIE Then
    Choix = "FERIE"
    ElseIf peType = E_DEPLACEMENT Then
    Choix = "D"
  Else
    MsgBox "Type non prévu :" & peType & vbCr & "Rien ne sera inscrit", vbExclamation
    Exit Sub
  End If

  Colonne = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1)

  For iLig = iLigDateDeb To iLigDateFin
    dtJour = oSh.Range("B" & iLig).Value
    If Not EstFérié(dtJour) And Weekday(dtJour) <> 7 And Weekday(dtJour) <> 1 Then
      'MsgBox dtJour
      ' Clear les colonne présence
      oSh.Cells(iLig, Colonne - 1).Value = IIf(Me.Frame2.Visible = True, Val(Replace(Me.TextBox1, ",", ".")), 1)
      NbHeure = NbHeure + oSh.Cells(iLig, Colonne - 1).Value
      oSh.Cells(iLig, Colonne).Value = Choix
      Select Case UCase(Choix)
        Case "CP", "RTTC", "RTTI", "MAL", "ATT", "CF", "AT", "CET", "PAT", "FERIE"
          oSh.Cells(iLig, Colonne - 2).ClearContents
        Case "HR-"
          If oSh.Cells(iLig, Colonne - 1) >= 3.5 Then EnPlus = 0.5
          oSh.Cells(iLig, Colonne - 2) = oSh.Cells(iLig, Colonne - 2) - oSh.Cells(iLig, Colonne - 1) - EnPlus
      End Select
    End If
  Next iLig
  
'genere la liste des demande d'absence
  With Sheets("Demande d'absence")
    .Range("A1:E1") = Array("Operateur", "Du", "Au", "Choix", "Heure/jour")
    Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & Ligne) = Me.ComboBox1
    .Range("B" & Ligne) = pdtDeb
    .Range("C" & Ligne) = pdtFin
    .Range("D" & Ligne) = Choix
    '.Range("E" & Ligne) = IIf(Me.Frame2.Visible = True, NbHeure, "")
    .Range("E" & Ligne) = NbHeure
    .Columns("A:E").AutoFit
  End With
  
  Set oSh = Nothing

End Sub
'V0.1-fin

Private Sub B_valid_Click()
  ActiveCell.Value = Me.date_début
  ActiveCell.Offset(0, 1).Value = Me.date_fin
End Sub

'V0.1
Private Sub cmdQuitter_Click()
  Unload Me
End Sub
'V0.1-fin

'V0.1
Private Sub cmdValider_Click()

Dim eType As E_TypeConges

  'contrôles
  
  If Me.Frame2.Visible = True And Not IsNumeric(Me.TextBox1) Then
    MsgBox "Indiquer le nombre d'heure"
    Me.TextBox1.SetFocus
    Exit Sub
  End If
  
  If Me.ComboBox1.ListIndex = -1 Then
    MsgBox "Veuillez choisir un opérateur"
    Me.ComboBox1.SetFocus
    Exit Sub
  End If
  
  If date_début.Text = "" Then
    MsgBox "Veuillez renseigner la date de début !", vbExclamation
    date_début.SetFocus
    Exit Sub
  End If

  If Not IsDate(date_début.Text) Then
    MsgBox "Date de début incorrecte !" & vbCrLf & date_début.Text, vbExclamation
    date_début.SetFocus
    Exit Sub
  End If

  If date_fin.Text = "" Then
    MsgBox "Veuillez renseigner la date de fin !", vbExclamation
    date_fin.SetFocus
    Exit Sub
  End If

  If Not IsDate(date_fin.Text) Then
    MsgBox "Date de fin incorrecte !" & vbCrLf & date_fin.Text, vbExclamation
    date_fin.SetFocus
    Exit Sub
  End If

  If optCP.Value Then
    eType = E_CP
  ElseIf optMaladie.Value Then
    eType = E_Maladie
  ElseIf optRTTC.Value Then
    eType = E_RTTC
  ElseIf optRTTI.Value Then
    eType = E_RTTI
  ElseIf OptAT.Value Then
    eType = E_AT
  ElseIf OptPAT.Value Then
    eType = E_PAT
  ElseIf OptSANSSOLDE.Value Then
    eType = E_SANSSOLDE
    ElseIf OptATT.Value Then
    eType = E_ATT
    ElseIf OptCF.Value Then
    eType = E_CF
    ElseIf OptCET.Value Then
    eType = E_CET
    ElseIf OptFERIE.Value Then
    eType = E_FERIE
    ElseIf OptDEPLACEMENT.Value Then
    eType = E_DEPLACEMENT
  ElseIf OptHR.Value Then
    eType = E_HR
  Else
    eType = E_Aucun
    MsgBox "Veuillez choisir le type de congés !" & vbCrLf & date_fin.Text, vbExclamation
    Exit Sub
  End If

  Valider CDate(date_début.Text), CDate(date_fin.Text), eType

End Sub
'V0.1-fin
Private Sub OptDEPLACEMENT_Click()
  Me.Frame2.Visible = False
End Sub
Private Sub OptFERIE_Click()
  Me.Frame2.Visible = False
End Sub
Private Sub OptCET_Click()
  Me.Frame2.Visible = False
End Sub
Private Sub OptCF_Click()
  Me.Frame2.Visible = False
End Sub
Private Sub OptATT_Click()
  Me.Frame2.Visible = False
End Sub
Private Sub OptAT_Click()
  Me.Frame2.Visible = False
End Sub

Private Sub optCP_Click()
  Me.Frame2.Visible = False
End Sub

Private Sub OptHR_Click()
  Me.Frame2.Visible = True
End Sub


Private Sub optMaladie_Click()
  Me.Frame2.Visible = False
End Sub

Private Sub OptPAT_Click()
  Me.Frame2.Visible = False
End Sub

Private Sub optRTTC_Click()
  Me.Frame2.Visible = False
End Sub

Private Sub optRTTI_Click()
  Me.Frame2.Visible = False
End Sub

Private Sub OptSANSSOLDE_Click()
  Me.Frame2.Visible = True
End Sub

Private Sub UserForm_Initialize()
Dim décal
Dim Depart As String, Cel As Range

  Me.Frame2.Visible = False
  affiche_calendrier (Date)
  mois_courant = Date
  décal = Weekday(DateSerial(Year(mois_courant), Month(mois_courant), 1), vbMonday) - 1
  Me.Mois = Application.Proper(Format(Date, "mmmm yy"))
  With Me.ComboBox1
    .ColumnCount = 2
    .ColumnWidths = "-1;0"
      Set Cel = Sheets("Planning").Rows(19).Find(what:="*", LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        Depart = Cel.Address
        Do
          If Cel.Column > 4 And Trim(Cel) <> "" Then
          .AddItem Trim(Cel)
          .List(.ListCount - 1, 1) = Cel.Column + 2
        End If
          Set Cel = Sheets("Planning").Rows(19).FindNext(Cel)
        Loop While Depart <> Cel.Address
      End If
  End With
End Sub
Function pression(no_cellule)
Dim K, décal
  décal = Weekday(DateSerial(Year(mois_courant), Month(mois_courant), 1)) - 2
  If décal = -1 Then décal = 6
  If témoin = 0 Then
    raz
    Me("texte" & no_cellule).BackColor = 65535
    Début = no_cellule
    témoin = 1
    Me.date_début = DateSerial(Year(mois_courant), Month(mois_courant), Début - décal)      ' date début
    Me.date_fin = Null
  Else
    d = DateSerial(Year(mois_courant), Month(mois_courant), no_cellule - décal)
    'If no_cellule < Début Then
    If d < CDate(Me.date_début) Then
      Début = no_cellule
      raz
      Me("texte" & no_cellule).BackColor = 65535
    Else
      Fin = no_cellule
      Me.date_fin = DateSerial(Year(mois_courant), Month(mois_courant), Fin - décal)      ' date fin
      raz
      If Month(Me.date_début) = Month(Me.date_fin) Then
        For K = Début To Fin
          'If Me("texte" & K).BackColor = vbWhite Then
          Me("texte" & K).BackColor = 65535
          'End If
        Next K
      Else
        For K = 1 To Fin
          'If Me("texte" & K).BackColor = vbWhite Then
          Me("texte" & K).BackColor = 65535
          'End If
        Next K
      End If
      témoin = 0
    End If
  End If
End Function
Sub affiche_calendrier(dt)
Dim premier_jour_mois, premier_jour_mois_suiv, décal, nb_jours, i
  premier_jour_mois = DateSerial(Year(dt), Month(dt), 1)
  premier_jour_mois_suiv = DateAdd("m", 1, premier_jour_mois)
  nb_jours = premier_jour_mois_suiv - premier_jour_mois + 1
  décal = Weekday(premier_jour_mois, vbMonday) - 1
  i = 1
  Do While i < nb_jours
    Me("texte" & i + décal).Caption = i
    If EstFérié(DateSerial(Year(dt), Month(dt), i)) = True Then Me("texte" & i + décal).BackColor = vbGreen
    i = i + 1
  Loop
  Me("texte" & Day(dt) + décal).BackColor = 255
  Me.Mois = Application.Proper(Format(dt, "mmmm yy"))
End Sub

Private Sub raz_tot()
Dim i
  For i = 1 To 37
    Me("texte" & i).BackColor = vbWhite
    Me("texte" & i).Caption = ""
  Next i
  For i = 1 To 35 Step 7
    Me("texte" & i + 5).BackColor = vbGreen
    Me("texte" & i + 6).BackColor = vbGreen
  Next i
End Sub
Private Sub raz()
Dim i
  For i = 1 To 37
    If Me("texte" & i).BackColor = 65535 Then
      Me("texte" & i).BackColor = vbWhite
    End If
  Next i
  For i = 1 To 35 Step 7
    Me("texte" & i + 5).BackColor = vbGreen
    Me("texte" & i + 6).BackColor = vbGreen
  Next i
End Sub
Private Sub moins_Click()
  mois_courant = DateAdd("m", -1, mois_courant)
  témoin = 0
  Me.date_début = mois_courant
  raz_tot
  affiche_calendrier (mois_courant)
End Sub
Private Sub plus_Click()
  mois_courant = DateAdd("m", 1, mois_courant)
  raz_tot
  affiche_calendrier (mois_courant)
End Sub

Private Sub texte1_Click()
  pression (1)
End Sub
Private Sub texte2_Click()
  pression (2)
End Sub
Private Sub texte3_Click()
  pression (3)
End Sub
Private Sub texte4_Click()
  pression (4)
End Sub
Private Sub texte5_Click()
  pression (5)
End Sub
Private Sub texte6_Click()
  pression (6)
End Sub
Private Sub texte7_Click()
  pression (7)
End Sub
Private Sub texte8_Click()
  pression (8)
End Sub
Private Sub texte9_Click()
  pression (9)
End Sub
Private Sub texte10_Click()
  pression (10)
End Sub
Private Sub texte11_Click()
  pression (11)
End Sub
Private Sub texte12_Click()
  pression (12)
End Sub
Private Sub texte13_Click()
  pression (13)
End Sub
Private Sub texte14_Click()
  pression (14)
End Sub
Private Sub texte15_Click()
  pression (15)
End Sub
Private Sub texte16_Click()
  pression (16)
End Sub
Private Sub texte17_Click()
  pression (17)
End Sub
Private Sub texte18_Click()
  pression (18)
End Sub
Private Sub texte19_Click()
  pression (19)
End Sub
Private Sub texte20_Click()
  pression (20)
End Sub
Private Sub texte21_Click()
  pression (21)
End Sub
Private Sub texte22_Click()
  pression (22)
End Sub
Private Sub texte23_Click()
  pression (23)
End Sub
Private Sub texte24_Click()
  pression (24)
End Sub
Private Sub texte25_Click()
  pression (25)
End Sub
Private Sub texte26_Click()
  pression (26)
End Sub

Private Sub texte27_Click()
  pression (27)
End Sub
Private Sub texte28_Click()
  pression (28)
End Sub
Private Sub texte29_Click()
  pression (29)
End Sub
Private Sub texte30_Click()
  pression (30)
End Sub
Private Sub texte31_Click()
  pression (31)
End Sub
Private Sub texte32_Click()
  pression (32)
End Sub
Private Sub texte33_Click()
  pression (33)
End Sub
Private Sub texte34_Click()
  pression (34)
End Sub
Private Sub texte35_Click()
  pression (35)
End Sub
Private Sub texte36_Click()
  pression (36)
End Sub
Private Sub texte37_Click()
  pression (37)
End Sub
Function EstFérié(dt)
Static j(11), m(11), témoinjf, pâques, i
  j(1) = 1: m(1) = 1
  j(2) = 1: m(2) = 5
  j(3) = 8: m(3) = 5
  j(4) = 14: m(4) = 7
  j(5) = 15: m(5) = 8
  j(6) = 1: m(6) = 11
  j(7) = 11: m(7) = 11
  j(8) = 25: m(8) = 12
  pâques = Round(DateSerial(Year(dt), 4, (234 - 11 * (Year(dt) Mod 19)) Mod 30) / 7, 0) * 7 - 6
  j(9) = Day(pâques + 1): m(9) = Month(pâques + 1)
  j(10) = Day(pâques + 39): m(10) = Month(pâques + 39)
  j(11) = Day(pâques + 50): m(11) = Month(pâques + 50)
  témoinjf = False
  For i = 1 To 11
    If Day(dt) = j(i) And Month(dt) = m(i) Then
      témoinjf = True
    End If
  Next
  EstFérié = témoinjf
End Function

merci de ton aide en tout cas
Cordialement PloZ

ploz · 20 Janvier 2016

Re : Ajout d'un case a cocher

rien qu'avec cela le fichier et trop lourd pour être posté sur le fofo :s

ploz · 21 Janvier 2016

Re : Ajout d'un case a cocher

Personne ???

misteryann · 21 Janvier 2016

Re : Ajout d'un case a cocher

Bonsoir Ploz.
J'utilise le même code pour autre chose (code récupéré sur le site de JBG

non?).
Il faut peut-être alléger ton fichier en supprimant les USF non nécessaires.
Cordialement.

ploz · 22 Janvier 2016

Re : Ajout d'un case a cocher

Bonsoir,
oui c'est cela si mes souvenir sont bon

enfaite dans le calendrier je lui et ajouter des texte que l'on peut cocher un combobox ect ... celui ci fonctionne tres bien sauf que je lui et ajouter une option un peu plus tard " option sans soldes "

si par exemple dans mon calendrier je coche HR- celui ci me transmet les données dans que j'ai saisie dans la colonne opérateeur choisi dans le menu déroulant et me calcul pour faire la somme de 8h

avec ce code
Case "HR-"
If oSh.Cells(iLig, Colonne - 1) >= 3.5 Then EnPlus = 0.5
oSh.Cells(iLig, Colonne - 2) = oSh.Cells(iLig, Colonne - 2) - oSh.Cells(iLig,

donc enfaite je voudrais que pour le sans soldes sa effectue la meme chose

merci de votre aide

(ps si necessaire je poste le fichier sur le serveurcjoint demain matin des que je rentre du taff )

ploz · 22 Janvier 2016

Re : Ajout d'un case a cocher

bonjour,
voici le fichier

Document Cjoint

ploz · 22 Janvier 2016

Re : Ajout d'un case a cocher

toujours personne ?

ploz · 24 Janvier 2016

Re : Ajout d'un case a cocher

toujours personne ?

Effectuez une recherche sur Excel Downloads...

Ajout d'un case a cocher

ploz

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

JCGL

XLDnaute Barbatruc

ploz

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

misteryann

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

ploz

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums