insérer des lignes dnas un tableau en fonciton de date

[aeryne]

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.

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

 

[bbb38]

Re : insérer des lignes dnas un tableau en fonciton de date

Bonjour aeryne, le forum,
Si tu peux modifier la présentation de tes données (voir feuille « test » - fichier ci-joint), tu pourras enregistrer tes données à la suite, puis, soit les trier par une date, soit les filtrer. Je ne sais pas trier des données avec la présentation de ton fichier.
Cordialement,
Bernard

 

[aeryne]

Re : insérer des lignes dnas un tableau en fonciton de date

je comprends ton système je rajoute juste un filtre automatique mais l'inconvénient c'est que toutes les infos ne sont pas visible en une seule fois.
je soumettrais ton idée mais je ne pense pas qu’elle sera assez pratique.

j’avais pensé à un truc du style ça compare par exemple le numéro de dossier et si l'ordinateur repère qu'il doit se placer entre 2 dossiers existants alors il insère le nombre de ligne nécessaire (4 dans le cas de ce fichier ) ou le nombre de cellule adéqua (4 cellules l'une au dessus de l'autre dans les colonne B D F H J ) pour conservé les intitulé des autres colonnes puis que ça y colle les informations

 

[aeryne]

Re : insérer des lignes dnas un tableau en fonciton de date

un petit up.

quelqu’un aurait une idée?

 

[aeryne]

Re : insérer des lignes dnas un tableau en fonciton de date

personne n'a d'idée?

 

[bbb38]

Re : insérer des lignes dnas un tableau en fonciton de date

Bonjour aeryne, le forum,
Une solution ci-jointe (voir onglet Souchi). La colonne A peut être masquée. J’ai annulé la fusion des cellules.
Cordialement,
Bernard

 

[aeryne]

Re : insérer des lignes dnas un tableau en fonciton de date

super ton idée j'y avais pas pensé.
si la colonne est masquée est ce que ca marchera sans souci l'import des données et le tri?

 

[aeryne]

Re : insérer des lignes dnas un tableau en fonciton de date

ca marche nickel j'ai pu l'adapté à mon userform super merci

 

[aeryne]

Re : insérer des lignes dnas un tableau en fonciton de date

salut
je suis à mon boulot et sur l'ordi du travail ca ne arche pas. este que ca peut venir du fait que c'est excel 2003?

il bloque sur cette ligne la: Worksheets("Feuil1").Sort.SortFields.Clear