1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
|
Dim Tableau(15) As Long
Dim L As Long
' Remet à zero chacun des champs aprés avoir validé
Private Sub cbNom_Change()
cmdVal.Enabled = False
lbChoix.Clear
chkOk.Value = False
'Encadré Rechercher---------------------------------
txtDateDeb.Text = ""
txtDateFin.Text = ""
'Encadré Formation----------------------------------
txtCat.Text = ""
txtDom.Text = ""
txtComp.Text = ""
txtOrg.Text = ""
txtNum.Text = ""
txtType.Text = ""
'Encadré Coûts previsionnel-------------------------
txtCp.Text = ""
txtCt.Text = ""
txtCh.Text = ""
'Encadré budget-------------------------------------
txtFi.Text = ""
txtDis.Text = ""
'Encadré Infos collab ------------------------------
txtCtt.Text = ""
txtDir.Text = ""
txtSer.Text = ""
txtMan.Text = ""
'Encadré Planification -----------------------------
txtDate.Text = ""
txtTps.Text = ""
'Encadré Date --------------------------------------
ChkA.Value = False
'------------------------------
ChkB.Value = False
'------------------------------
ChkC.Value = False
'Encadré Finaliser ----------------------------------
chkOk.Value = False
chkNo.Value = False
txtDateDeb.Text = ""
txtDateFin.Text = ""
txtcoment.Text = ""
'Encadré Envoi AGEFOS--------------------------------
DTPicker7.Day = 1
'Encadré Prise en charge ----------------------------
txtAgefos.Text = ""
txtASP.Text = ""
'Tableau = 0
ind2 = 1
For lig = 2 To 15000
If Cells(lig, 2) = cbNom.Value Then
lbChoix.AddItem Cells(lig, 15)
' chaque fois que l'on met à jour un AddItem on
' stock dans le Dim Tableau le numero de la ligne
Tableau(ind2) = lig
ind2 = ind2 + 1
End If
Next lig
End Sub
'Ecriture
Private Sub cmdVal_Click()
With Sheets("Base")
'Encadré Formation----------------------------------
.Cells(L, 18) = txtCat.Text
.Cells(L, 23) = txtDom.Text
.Cells(L, 17) = txtComp.Text
.Cells(L, 13) = txtOrg.Text
.Cells(L, 14) = txtNum.Text
.Cells(L, 16) = txtType.Text
'Encadré Coûts -------------------------
.Cells(L, 25) = txtCp.Text
.Cells(L, 26) = txtCt.Text
.Cells(L, 27) = txtCh.Text
'Encadré budget-------------------------------------
.Cells(L, 21) = txtFi.Text
.Cells(L, 22) = txtDis.Text
'Encadré Infos collab ------------------------------
.Cells(L, 3) = txtCtt.Text
.Cells(L, 6) = txtDir.Text
.Cells(L, 7) = txtSer.Text
.Cells(L, 9) = txtMan.Text
'Encadré Planification -----------------------------
.Cells(L, 19) = txtDate.Text
.Cells(L, 20) = txtTps.Text
'Encadré Date --------------------------------------
.Cells(L, 28) = DTPicker1.Value
.Cells(L, 29) = DTPicker2.Value
.Cells(L, 30) = ChkA.Value
'---------------------------
.Cells(L, 31) = DTPicker3.Value
.Cells(L, 32) = DTPicker4.Value
.Cells(L, 33) = ChkB.Value
'---------------------------
.Cells(L, 34) = DTPicker5.Value
.Cells(L, 35) = DTPicker6.Value
.Cells(L, 36) = ChkC.Value
'Encadré Finaliser ----------------------------------
.Cells(L, 39) = chkOk.Value
.Cells(L, 40) = chkNo.Value
.Cells(L, 37) = txtDateDeb.Text
.Cells(L, 38) = txtDateFin.Text
.Cells(L, 44) = txtcoment.Text
'Encadré Envoi AGEFOS--------------------------------
.Cells(L, 41) = DTPicker7.Value
'Encadré Prise en charge ----------------------------
.Cells(L, 42) = txtAgefos.Text
.Cells(L, 43) = txtASP.Text
End With
cmdVal.Enabled = False
End Sub
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub DTPicker2_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub DTPicker8_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
'Recherche
Private Sub lbChoix_Click()
Num = lbChoix.ListIndex + 1
L = Tableau(Num)
With Sheets("Base") ' permet d'eviter de répeter Sheets ("Base") à chaque ligne
'Encadré Formation----------------------------------
txtCat.Text = .Cells(L, 18)
txtDom.Text = .Cells(L, 23)
txtComp.Text = .Cells(L, 17)
txtOrg.Text = .Cells(L, 13)
txtNum.Text = .Cells(L, 14)
txtType.Text = .Cells(L, 16)
'Encadré Coûts--------------------------------------
txtCp.Text = .Cells(L, 25)
txtCt.Text = .Cells(L, 26)
txtCh.Text = .Cells(L, 27)
'Encadré budget-------------------------------------
txtFi.Text = .Cells(L, 21)
txtDis.Text = .Cells(L, 22)
'Encadré Infos collab ------------------------------
txtCtt.Text = .Cells(L, 3)
txtDir.Text = .Cells(L, 6)
txtSer.Text = .Cells(L, 7)
txtMan.Text = .Cells(L, 9)
'Encadré Planification -----------------------------
txtDate.Text = .Cells(L, 19)
txtTps.Text = .Cells(L, 20)
'Encadré Date --------------------------------------
DTPicker1.Value = .Cells(L, 28)
DTPicker2.Value = .Cells(L, 29)
ChkA.Value = .Cells(L, 30)
'------------------------------
DTPicker3.Value = .Cells(L, 31)
DTPicker4.Value = .Cells(L, 32)
ChkB.Value = .Cells(L, 33)
'------------------------------
DTPicker5.Value = .Cells(L, 34)
DTPicker6.Value = .Cells(L, 35)
ChkC.Value = .Cells(L, 36)
'Encadré Finaliser ----------------------------------
chkOk.Value = .Cells(L, 39)
chkNo.Value = .Cells(L, 40)
txtDateDeb.Text = .Cells(L, 37)
txtDateFin.Text = .Cells(L, 38)
txtcoment.Text = .Cells(L, 44)
'Encadré Envoi AGEFOS--------------------------------
DTPicker7.Value = .Cells(L, 41)
'Encadré Prise en charge ----------------------------
txtAgefos.Text = .Cells(L, 42)
txtASP.Text = .Cells(L, 43)
If chkOk.Value = True Then
lblMess = "Cette formation à déja été réalisée"
Else
lblMess = ""
End If
End With
cmdVal.Enabled = True
'FrmFormulaire.Hide
'FrmResultat.Show
End Sub
Private Sub UserForm_Initialize()
cmdVal.Enabled = False
' cbNom.AddItem "Toto"
'For ind = 0 To 10271
'For lig = 2 To 800
'If Cells(lig, 1) = ind Then
'cbNom.AddItem Cells(lig, 2)
'Exit For
'End If
'Next lig
'Next ind
Worksheets("Base").Range("A1:AF15000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For lig = 2 To 15000
If Cells(lig, 1) <> Cells(lig - 1, 1) Then
cbNom.AddItem Cells(lig, 2)
End If
Next lig
End Sub |
Partager