Bonjour
Je suis en train de créer un formulaire sur un fichier excel pour qu'il remplisse 3 fichiers excel différents en fonction des critère remplis. J'arrive à tout faire comme j'en ai envie mais le seul point qui bloque c'est que l'insertion des lignes doit se faire en fonction de la date que j'entre dans le formulaire. en effet parfois je ne peux pas entrer le dossier de façon informatique le dossier le temps que je n'ai pas tous les documents papier en main.
Pouvez vous m'indiquer un code qui pourrait m'aider.
voici le code qui est présent sur le fichier qui contrôle le formulaire. je ne peux pas vous mettre ce fichier car il est trop gros. je vais vous joindre par contre un fichier qui doit être compléter par le formulaire.
Je suis en train de créer un formulaire sur un fichier excel pour qu'il remplisse 3 fichiers excel différents en fonction des critère remplis. J'arrive à tout faire comme j'en ai envie mais le seul point qui bloque c'est que l'insertion des lignes doit se faire en fonction de la date que j'entre dans le formulaire. en effet parfois je ne peux pas entrer le dossier de façon informatique le dossier le temps que je n'ai pas tous les documents papier en main.
Pouvez vous m'indiquer un code qui pourrait m'aider.
voici le code qui est présent sur le fichier qui contrôle le formulaire. je ne peux pas vous mettre ce fichier car il est trop gros. je vais vous joindre par contre un fichier qui doit être compléter par le formulaire.
Code:
Public Expert As Byte
Private Sub CheckBox9_Click()
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Dim NF, dl&
NF = Array("CC", "LH", "GT", "DA")
With Sheets(NF(Expert))
.Activate
dl = .Cells(Rows.Count, "D").End(xlUp).Row + 1
.Cells(dl, "A") = TextBox1
.Cells(dl, "B") = TextBox2
.Cells(dl, "C") = TextBox3 & " " & TextBox4
.Cells(dl, "D") = NF(Expert)
.Cells(dl, "E") = ComboBox1.Value
.Cells(dl, "F") = IIf(CheckBox1, 1, vbNullString)
.Cells(dl, "G") = IIf(CheckBox2, 1, vbNullString)
.Cells(dl, "H") = IIf(CheckBox3, 1, vbNullString)
.Cells(dl, "I") = IIf(CheckBox4, 1, vbNullString)
.Cells(dl, "J") = IIf(CheckBox5, 1, vbNullString)
.Cells(dl, "K") = IIf(CheckBox6, 1, vbNullString)
.Cells(dl, "L") = ComboBox2.Value
.[A1].Select
End With
y = Workbooks("EXPERTS 2014.xls").FullName 'recupere le chemin de ton fichier excel genre "C:\documents\PRINCIPAL.xls"
x = Workbooks("EXPERTS 2014.xls").Name 'recupere le nom du fichier excel "PRINCIPAL.xls"
lg = Len(x) 'len=longueur
chemin = Mid(y, 1, Len(y) - Len(x)) 'recupere juste le chemin "C:\documents\"
Workbooks.Open (chemin + "Tableau LILLE Résultats AVP 2014.xls")
Workbooks.Open (chemin + "fichier conservation dossier échantillons 2014.xls")
If CheckBox4.Value = True Then
Windows("fichier conservation dossier échantillons 2014.xls").Activate
Sheets("Souchi").Select
Dim NC, dc&
NC = Array("Souchi")
With Sheets(NC(CheckBox))
.Activate
Sheets("Souchi").Select
dc = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(dc, "B") = TextBox1
.Cells(dc + 1, "B") = TextBox3
.Cells(dc + 2, "B") = TextBox4
.Cells(dc + 3, "B") = TextBox2
End With
End If
If CheckBox5.Value = True Then
Windows("fichier conservation dossier échantillons 2014.xls").Activate
Sheets("Expertises").Select
Dim ND, dd&
ND = Array("Expertises")
With Sheets(ND(CheckBox))
.Activate
Sheets("Expertises").Select
dd = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(dd, "B") = TextBox1
.Cells(dd + 1, "B") = TextBox3
.Cells(dd + 2, "B") = TextBox4
.Cells(dd + 3, "B") = TextBox2
End With
End If
If CheckBox5.Value = False And CheckBox4.Value = False Then
Windows("fichier conservation dossier échantillons 2014.xls").Activate
Sheets("AVP+ Conservation sans anal").Select
Dim NE, de&
NE = Array("AVP+ Conservation sans anal")
With Sheets(NE(CheckBox))
.Activate
Sheets("AVP+ Conservation sans anal").Select
de = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(de, "B") = TextBox1
.Cells(de + 1, "B") = TextBox3
.Cells(de + 2, "B") = TextBox4
.Cells(de + 3, "B") = TextBox2
End With
End If
If CheckBox5.Value = False And CheckBox4.Value = False Then
Windows("Tableau LILLE Résultats AVP 2014.xls").Activate
Sheets("Feuil1").Select
Dim NG, dg&
NG = Array("Feuil1")
With Sheets(NG(CheckBox))
.Activate
Sheets("Feuil1").Select
dg = .Cells(Rows.Count, "C").End(xlUp).Row + 1
.Cells(dg, "A") = TextBox1
.Cells(dg, "B") = TextBox2
.Cells(dg, "C") = TextBox3 & " " & TextBox4
.Cells(dg, "D") = TextBox5
.Cells(dg, "H") = IIf(CheckBox7, "U", vbNullString) & IIf(CheckBox8, "S", vbNullString) & IIf(CheckBox9, "NE", vbNullString) & IIf(CheckBox10, "NP", vbNullString)
.Cells(dg, "X") = ComboBox3.Value & " de " & ComboBox4.Value & " par OPJ: " & TextBox6
If Cells(dg, "D") <> "" Then
datnais = Cells(dg, "D").Value
datdec = Now
jn = DatePart("d", datnais)
mn = DatePart("m", datnais)
an = DatePart("yyyy", datnais)
jd = DatePart("d", datdec)
md = DatePart("m", datdec)
ad = DatePart("yyyy", datdec)
'calcul nbre années
If md > mn Then qdm = "apres"
If md = mn Then qdm = "egal"
If md < mn Then qdm = "avt"
If jd > jn Then qdj = "apres"
If jd = jn Then qdj = "egal"
If jd < jn Then qdj = "avt"
If qdm = "apres" Then nbran = ad - an
If qdm = "apres" Then GoTo line1:
If qdm = "egal" And jd >= jn Then nbran = ad - an
If qdm = "egal" And jd >= jn Then GoTo line1:
nbran = ad - an - 1
GoTo line2:
'calcul nbre de jours si anniv ok
line1:
dattransf = DateSerial(ad, mn, jn)
nbrj = DateDiff("d", dattransf, datdec)
GoTo line3:
'calcul nbre de jours si anniv ko
line2:
dattransf1 = DateSerial(ad - 1, mn, jn)
datfinan = DateSerial(ad - 1, 12, 31)
jfinan = DateDiff("d", dattransf1, datfinan)
datdeban = DateSerial(ad, 1, 1)
jdeban = DateDiff("d", datdeban, datdec)
nbrj = jfinan + jdeban
line3:
.Cells(dg, "E") = "" & nbran & Chr(13)
End If
End With
End If
Windows("Tableau LILLE Résultats AVP 2014.xls").Activate
ActiveWorkbook.Save
Windows("fichier conservation dossier échantillons 2014.xls").Activate
ActiveWorkbook.Save
Windows("EXPERTS 2014.xls").Activate
ActiveWorkbook.Save
UserForm1.Hide
Unload UserForm1
End Sub
Private Sub Label9_Click()
End Sub
Private Sub OptionButton1_Click()
Expert = 0
End Sub
Private Sub OptionButton2_Click()
Expert = 1
End Sub
Private Sub OptionButton3_Click()
Expert = 2
End Sub
Private Sub OptionButton4_Click()
Expert = 3
End Sub
Private Sub TextBox1_Change()
End Sub