Définition classeur cible en fonction d'une date

Talzatior

XLDnaute Occasionnel
Re à vous, chers xldiens ;)

Je viens cette fois-ci vers vous pour une confirmation.
Je suis sur mon pc perso, et n'ai pas les fichiers de compta à disposition pour voir si ma macro fonctionne, mais j'aimerai votre avis sur le sujet.
En fait, je souhaite définir mon classeur cible en fonction de la date appelée ici fact_date.

Voilà ma macro :
Code:
Sub Compta_fact()
Dim fact_num As String
Dim fact_date As Date
Dim cmd_num As String
Dim cmd_date As Date
Dim nom_clt As String
Dim ech_date As Date
Dim tot_HT As Double
Dim num_ligne As Integer
Dim WB As Workbook

'collecte les infos de la facture
fact_num = Range("A14").Value
fact_date = Range("A16").Value
cmd_num = CStr(Range("C16").Value)
cmd_date = Range("D16").Value
nom_clt = CStr(Range("F9").Value)
ech_date = Range("H16").Value
tot_HT = Range("F43").Value

'Définit le classeur cible en fonction de la date de facture
If fact_date >= #1/1/2009# And fact_date <= #3/31/2009# Then WB = "C:\COMPTA\2009\1ER TRIMESTRE.xls"
If fact_date >= #1/4/2009# And fact_date <= #6/30/2009# Then WB = "C:\COMPTA\2009\2EME TRIMESTRE.xls"
If fact_date >= #1/7/2009# And fact_date <= #9/30/2009# Then WB = "C:\COMPTA\2009\3EME TRIMESTRE.xls"
If fact_date >= #1/10/2009# And fact_date <= #12/31/2009# Then WB = "C:\COMPTA\2009\4EME TRIMESTRE.xls"

'ouverture du classeur archive_facture2009.xls
Workbooks.Open "WB"
'teste si le classeur cible est en lecture seule
If Workbooks("WB").ReadOnly Then
    If MsgBox("Le classeur auquel vous tentez d'accéder est en lecture seule, veuillez recommencer votre manipulation svp.", vbYesNo) = vbYes Then Workbooks("WB").Close False
End If
Workbooks("Archives_test.xls").Activate
Sheets("Factures").Activate
'Cherche la première ligne vide
Range("A1").Select
While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Wend
'Défini le numéro de la première ligne vide dans la variable num_ligne
num_ligne = ActiveCell.Row
'Place les valeurs récupérées sur la facture dans le tableau
Worksheets("Factures").Cells(num_ligne, 1).Value = fact_num
Worksheets("Factures").Cells(num_ligne, 2).Value = fact_date
Worksheets("Factures").Cells(num_ligne, 3).Value = cmd_num
Worksheets("Factures").Cells(num_ligne, 4).Value = cmd_date
Worksheets("Factures").Cells(num_ligne, 5).Value = nom_clt
Worksheets("Factures").Cells(num_ligne, 6).Value = tot_HT
Worksheets("Factures").Cells(num_ligne, 9).Value = ech_date
'Sauvegarde et ferme le classeur d'archive
Workbooks("Archives_test.xls").Save
Workbooks("Archives_test.xls").Close


MsgBox "archivage de la facture n° " & fact_num & " effectué avec succès"

End Sub

Est-ce que cela peut fonctionner :confused::confused:

Merci par avance à vous ;)
 

Catrice

XLDnaute Barbatruc
Re : Définition classeur cible en fonction d'une date

Bonsoir,

Pas sur d'avoir tout compris mais pour répondre à ta question ça peut fontionner mais il faut enlever les "" autour de WB => Workbooks.Open WB
Dans ton code, je ne comprends pas où est utilisé le fichier de la variable WB.
Ci-dessous une variante à tester et à adapter :

Sub Compta_fact()
Ordre = Array("1ER", "2EME", "3EME", "4EME")
For i = 1 To 12 Step 3
With ThisWorkbook.Sheets("facture")
If .Range("A16") >= DateSerial(2009, i, 1) And .Range("A16") <= DateSerial(2009, i + 3, 0) Then WB = "C:\COMPTA\2009\" & Ordre(i / 3) & " TRIMESTRE.xls": Exit For
End With
Next
Set MonClass = Workbooks.Open(Filename:=WB, IgnoreReadOnlyRecommended:=True)
MesSourc = Array("A14", "A16", "C16", "D16", "F9", "F43", "H16")
With MonClass.Sheets(1)
Malig = .Range("A65536").End(xlUp).Offset(1, 0).Row
For i = 1 To 7
.Cells(Malig, IIf(i = 7, 9, i)).Value = ThisWorkbook.Sheets("facture").Range(MesSourc(i - 1)).Value
Next
End With
MonClass.Close True
MsgBox "archivage de la facture n° " & ThisWorkbook.Sheets("facture").Range("A14") & " effectué avec succès"
End Sub

Voir fichiers joints.
 

Pièces jointes

  • COMPTA.zip
    26.1 KB · Affichages: 31
  • COMPTA.zip
    26.1 KB · Affichages: 35
  • COMPTA.zip
    26.1 KB · Affichages: 27

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 413
Messages
2 088 199
Membres
103 763
dernier inscrit
p.michaux