probleme dans macro excel 2000

Bonjour,
j'ai une macro dont une procedure (sub traitement impayes) me retourne un
fichier .xls et un fichier.txt.
le fichier .xls est ok mais le fichier.txt me renvoie un montant
erronné.il
senblerait que la macro supprime le 1er chiffre du montant ,prend la
chaine
de chiffre(limité à 5 chiffres max.) sans la virgule puis rajoute la
virgule
suivi de 2 chiffres.
ex si montant R3,13 on a dans le fichier.txt 2313,13
je n'arrive pas à trouver ce qui pose probleme dans la procedure..pouvez
vous m'eclairer...je vous laisse la macro

Sub choix()

menu_avip.Show

End Sub



Sub extraction_ACI()
'
'
Dim date_etat As String, date_aci2 As String
Const dir = "S:CONTENTIEUX_AVIPACI"
' Const DIR = "C:avipACI"

menu_avip.Hide

date_aci = InputBox("Les ACI de Quelle date doit-on extraire ?",
"ATTENTION
Saisir la date sous le format JJMMAA")
date_aci2 = Left$(date_aci, 2) & "/" & Mid(date_aci, 3, 2) & "/20" &
Right$(date_aci, 2)
' création fichier ACI _ date du jour

Workbooks.Open Filename:=dir & "matrice_ACI.xls"
Range("A2") = "ACI à saisir dans MISTRAL - " & date_aci2
nom_fich = "ACI_" & date_aci
ActiveWorkbook.SaveAs Filename:=dir & nom_fich


' traitement

Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select

Set debut = Range("B3")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next


For i = 3 To nb_lignes + 3
Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select
etat = Range("V" & i)
date_etat = Range("W" & i)

' MsgBox "etat = " & etat & " date_etat = " & date_etat & " date_aci2 > " & date_aci2

If etat = "ACI" And date_etat = date_aci2 Then
' stockage données à copier
avip = Range("B" & i)
rev = Range("C" & i)
nom = Range("D" & i)
date_defer = Range("M" & i)
creance = Range("L" & i)
mont_payés = Range("O" & i)
solde = Range("Q" & i)
mont_ACI = Range("R" & i)
motif_ACI = Range("S" & i)
' sélection fichier ACI pour collage
Windows(nom_fich & ".xls").Activate
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("A5") = avip
Range("B5") = rev
Range("C5") = nom
Range("D5") = date_defer
Range("E5") = creance
Range("F5") = mont_payés
Range("G5") = solde
Range("H5") = mont_ACI
Range("J5") = mont_ACI / 1.196
Range("I5") = mont_ACI - mont_ACI / 1.196
Range("K5") = motif_ACI
Range("N5") = etat
Range("O5") = date_etat
Range("O5").Select
Selection.NumberFormat = "dd/mm/yy;@"


End If

Next i

Windows(nom_fich & ".xls").Activate
Set debut = Range("A5")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next

Range("A5:O" & nb_lignes + 4).Select
Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

TTC = 0
TVA = 0
HT = 0

For k = 5 To nb_lignes + 4
TTC = TTC + Range("H" & k)
TVA = TVA + Range("I" & k)
HT = HT + Range("J" & k)
Next k

Range("H" & nb_lignes + 6) = TTC
Range("I" & nb_lignes + 6) = TVA
Range("J" & nb_lignes + 6) = HT


Range("H" & nb_lignes + 6 & ":J" & nb_lignes + 6).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With

compteur = 1
compteur_avip = 0
lignes_a_traiter = nb_lignes
nb_total = nb_lignes + 10
For j = 5 To nb_total
avip = Range("A" & j)
AVIP_suivant = Range("A" & j).Offset(1, 0)


If AVIP_suivant = avip Then
compteur = compteur + 1
lignes_a_traiter = lignes_a_traiter - 1
End If

If AVIP_suivant <> avip Then

compteur_avip = compteur_avip + 1
Rows(j + 1 & ":" & j + 1).Select
Selection.Insert Shift:=xlDown
Range("H" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"
Range("I" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"
Range("J" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"
Range("H" & j + 1 & ":J" & j + 1).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
compteur = 1
j = j + 1

End If

Next j

ActiveWorkbook.SaveAs Filename:=dir & nom_fich
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' ActiveWorkbook.Close
End Sub


Sub extraction_versement()
'
'
Dim date_etat As String, date_aci2 As String
Const dir = "S:CONTENTIEUX_AVIPRIOU"
'Const DIR = "C:avipRIOU"

menu_avip.Hide

date_RIOU = InputBox("Les Versements de Quelle date doit-on extraire ?",
"ATTENTION Saisir la date sous le format JJMMAA")
col = InputBox("Dans quelle colonne ont été saisis les paiements ? ")
date_RIOU2 = Left$(date_RIOU, 2) & "/" & Mid(date_RIOU, 3, 2) & "/20" &
Right$(date_RIOU, 2)
' création fichier Versements RIOU

Workbooks.Open Filename:=dir & "matrice_versements_RIOU.xls"
Range("A2") = "Versements RIOU du " & date_RIOU2
Range("K4") = "Vers. " & date_RIOU2
nom_fich = "Versements_RIOU_" & date_RIOU
ActiveWorkbook.SaveAs Filename:=dir & nom_fich


' traitement

Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select

Set debut = Range("B3")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next


For i = 3 To nb_lignes + 3
Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select
date_etat = Range("W" & i)

' MsgBox "etat = " & etat & " date_etat = " & date_etat & " date_aci2 > " & date_aci2

If date_etat = date_RIOU2 Then
' stockage données à copier
avip = Range("B" & i)
rev = Range("C" & i)
nom = Range("D" & i)
date_defer = Range("M" & i)
date_RIOU = Range("N" & i)
creance = Range("L" & i)
mont_payés = Range("O" & i)
solde = Range("Q" & i)
etat = Range("V" & i)
date_etat = Range("W" & i)
montant = Range(col & i)

' sélection fichier ACI pour collage
Windows(nom_fich & ".xls").Activate
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("A5") = avip
Range("B5") = rev
Range("C5") = nom
Range("D5") = creance
Range("E5") = date_defer
Range("F5") = date_RIOU
Range("G5") = mont_payés
Range("H5") = solde
Range("I5") = etat
Range("J5") = date_etat
Range("J5").Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("K5") = montant


End If

Next i

Windows(nom_fich & ".xls").Activate
Set debut = Range("A5")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next

Range("A5:K" & nb_lignes + 4).Select
Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

TTC = 0

For l = 5 To nb_lignes + 4
TTC = TTC + Range("k" & l)
Next l

Range("K" & nb_lignes + 6) = TTC

Range("k" & nb_lignes + 6).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With

compteur = 1
compteur_avip = 0
lignes_a_traiter = nb_lignes
nb_total = nb_lignes + 10
For j = 5 To nb_total
avip = Range("A" & j)
AVIP_suivant = Range("A" & j).Offset(1, 0)


If AVIP_suivant = avip Then
compteur = compteur + 1
lignes_a_traiter = lignes_a_traiter - 1
End If

If AVIP_suivant <> avip Then

compteur_avip = compteur_avip + 1
Rows(j + 1 & ":" & j + 1).Select
Selection.Insert Shift:=xlDown
Range("K" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"

Range("K" & j + 1).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
compteur = 1
j = j + 1

End If

Next j

ActiveWorkbook.SaveAs Filename:=dir & nom_fich
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' ActiveWorkbook.Close
End Sub

Sub Integration_fichier_suivi()

menu_avip.Hide

MsgBox "Merci de sélectionner le fichier OK_envoi_RIOU à traiter "
Application.FindFile
nomf = ActiveWorkbook.Name

Set debut = Range("A1")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next

Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select

Rows("3:" & nb_lignes + 2).Select
Selection.Insert Shift:=xlDown
Selection.Interior.ColorIndex = xlNone

For i = 3 To nb_lignes + 2
Range("U" & i).Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
Range("O" & i).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[8]:RC[92])"
Range("Q" & i).Select
ActiveCell.FormulaR1C1 = "=RC[-5]-RC[-1]-RC[-2]-RC[1]"
Range("U" & i).Select
ActiveCell.FormulaR1C1 = "=mois_comptable(RC[-1])"
Range("V" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]=0,IF(RC[-4]=0,""dossier
clôturé"",""ACI""),""en-cours"")"

Next i

For j = 1 To nb_lignes

Windows(nomf).Activate
avip = Range("A" & j)
rev = Range("B" & j)
nom = Range("D" & j)
date_defer = Date
numvoie = Range("E" & j)
typvoie = Range("F" & j)
nomvoie = Range("G" & j)
compl = Range("H" & j)
cp = Range("I" & j)
ville = Range("J" & j)
tel = Range("K" & j)
creance = Range("N" & j)

' sélection fichier ACI pour collage
Windows("suivi_dossiers_avip.xls").Activate
Range("B" & j + 2) = avip
Range("C" & j + 2) = rev
Range("D" & j + 2) = nom
Range("E" & j + 2) = numvoie
Range("F" & j + 2) = typvoie
Range("G" & j + 2) = nomvoie
Range("H" & j + 2) = compl
Range("I" & j + 2) = cp
Range("J" & j + 2) = ville
Range("K" & j + 2) = tel
Range("L" & j + 2) = creance
Range("M" & j + 2) = date_defer

Next j

Windows(nomf).Close



End Sub



Sub traitement_impayes()

Const dir = "s:CONTENTIEUX_AVIPRIOU"
' Const dir = "c:AVIPRIOU"
Dim nomfich As String
Dim debut As Range, fin As Range, maplage As Range, col As Variant
Dim bureau As String, typ As String, nom As String
Dim fichier As String, fichier_resultat As String
Dim i As Integer, nb_lignes As Integer, postit As String
Dim solde As Double, caution As Double, valeur As Double
Dim rue As String, tel1 As String, tel2 As String, montant As Double,
materiel As String

Date_jour = Date
Date_jour = Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 2)
fichier_resultat = Date_jour & "_resultat.txt"

On Error GoTo 1
Kill (fichier_resultat)
1

num_client = "04999"

' mise en forme fichier AVIP
menu_avip.Hide

MsgBox "Merci de choisir le fichier à traiter "
Application.FindFile

' Rows("1:1").Select
' Selection.Delete Shift:=xlUp
Columns("C:E").Select
Selection.Delete Shift:=xlToLeft
Columns("L:M").Select
Selection.Delete Shift:=xlToLeft
Columns("M:M").Select
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft

Set debut = Range("A1")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next

For j = 1 To nb_lignes
code_montant = Range("O" & j)
montant = CDbl(Range("N" & j))
Select Case code_montant
Case "C"
Range("N" & j) = -1 * montant
Case "D"
Range("N" & j) = montant
Case ""
Range("N" & j) = montant
End Select
Next j

nom_f = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:= _
dir & "en attente envoi" & "OK_" & nom_f, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:úlse, CreateBackup:úlse
nom_OK = ActiveWorkbook.Name

Set debut = Range("A1")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next




Range("A1:N" & nb_lignes).Select

Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

For m = 1 To nb_lignes
num_contrat = Range("B" & m)
contrat_suivant = Range("B" & m).Offset(1, 0)
contrat_suivant2 = Range("B" & m).Offset(2, 0)
col_L = Range("L" & m)
longueur = Len(col_L)
If contrat_suivant = "" Then
m = nb_lignes
GoTo fin:
End If
If contrat_suivant = num_contrat Then
If longueur = 11 Or longueur = 12 Then
facture1 = Range("L" & m) & "*" & Left(Range("M" & m), 6) &
Right(Range("M" & m), 2) & "*" & Range("N" & m) & "?"
Else
facture1 = Range("L" & m)
End If
facture2 = Range("L" & m + 1) & "*" & Left(Range("M" & m), 6) &
Right(Range("M" & m), 2) & "*" & Range("N" & m + 1) & "?"
resultat = facture1 & "+" & facture2
Range("L" & m) = resultat
Range("N" & m) = Range("N" & m) + Range("N" & m + 1)
Rows(m + 1 & ":" & m + 1).Select
Selection.Delete Shift:=xlUp
If contrat_suivant2 = num_contrat Then m = m - 1

Else
Range("L" & m) = Range("L" & m) & "*" & Left(Range("M" & m), 6) &
Right(Range("M" & m), 2) & "*" & Range("N" & m) & "?"
End If

Next m

fin:

Set debut = Range("A1")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next
Range("L" & nb_lignes) = Range("L" & nb_lignes) & " du " & Range("M" &
nb_lignes) & " de " & Range("N" & nb_lignes) & " EUR"


Cells.Select
Selection.Copy
Windows("macro_gestion_AVIP.xls").Activate
Sheets("macro").Select
Cells.Select
ActiveSheet.Paste




i = 1
For Each macellule In maplage

result = String(7, " ")
' numéro client RIOU
result = result & num_client
' calcul numéro client interne FT
ref_client = cadrage(Range("B" & i), 20, " ")
result = result & ref_client
' calcul code civilité
civ = civilite(Range("C" & i))
If civ = "" Then civ = "11"
result = result & civ
' calcul nom débiteur
nom = Range("D" & i)
nom_client = cadrage(nom, 30, " ")
result = result & nom_client
' calcul prenom debiteur
result = result & String(30, " ")
' calcul nom rue 1 & 2
num = Range("E" & i)
typvoie = Range("F" & i)
voie = Range("G" & i)
rue = num & " " & typvoie & " " & voie
ad = cadrage(rue, 60, " ")
result = result & ad
' code insee
result = result & insee(Range("I" & i))

' calcul commune
nom_commune = cadrage((Range("J" & i)), 30, " ")
result = result & nom_commune
' calcul code postal
cp = Range("I" & i)
If Len(cp) = 4 Then cp = "0" & cp
result = result & cp
' calcul bureau distributeur
result = result & String(30, " ")
' calcul n° tel 1
If Range("K" & i) = "" Then
tel1 = String(12, " ")
Else:
tel1 = Range("K" & i)
' num1 = Mid(tel1, 1, 2)
' num2 = Mid(tel1, 4, 2)
' num3 = Mid(tel1, 7, 2)
' num4 = Mid(tel1, 10, 2)
' num5 = Mid(tel1, 13, 2)
' tel1 = num1 + num2 + num3 + num4 + num5
End If
result = result & cadrage(tel1, 12, " ")
' calcul n° tel 2
result = result & cadrage(tel2, 12, " ")
' calcul n° RM/RC
result = result & String(15, " ")
' calcul siècle facture & date
Daters = Range("M" & i)
siecle = " 20"
annee = Mid(Daters, 3, 2)
mois = Mid(Daters, 5, 2)
siecle_date = siecle & " " & annee & mois
result = result & siecle_date

' calcul montant privilégié + tarif
result = result & " " & "000000000,00" & "B"
' calcul type créance + MOntant principal en francs français
If civ = "03" Or civ = "04" Or civ = "05" Or civ = "15" Or civ = "18" Or
civ
= "19" Or civ = "20" Then
typ = "1"
Else: typ = "2"
End If
result = result & typ & " " & "000000000,00"

' calcul siecle mise en demeure + date mise en demeure
result = result & " 00 000000"
' calcul libellé facture + fondement créance
result = result & String(160, " ")
' calcul code option + code pays
result = result & "201"
'calcul postit
col = "L" & i
postit = Range(col)
result = result & cadrage(postit, 80, " ")
' calcul litige + type débiteur + historique + code devise + montant
privilégié

adpost = cadrage(Range("H" & i), 73, " ")
result = result & "NP" & adpost & "EU" & " " & "000000000,00"
' calcul montant en principal
solde = CDbl(Range("N" & i))

principal = solde
montant_formaté = Format(principal, "#########,##0.00")

montant_formaté = montant_formaté * 100
montant = Str$(montant_formaté)
longueur = Len(montant)
partie_gauche = Left$(montant, longueur - 2)
partie_droite = Right$(montant, 2)
montant_final = partie_gauche & "," & partie_droite

montant = Mid$(montant_final, 2, Len(montant_final) - 1)
' MsgBox "resultat - montant final : " & montant & " longueur " &
Len(montant)

result = result & cadragedroite(montant)

Open fichier_resultat For Append As #1
Print #1, result
Close #1
i = i + 1
Next macellule



' Windows("macro_fi").Activate
Cells.Select
Selection.Delete
Windows(nom_OK).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Le fichier " & site & "_resultat peut être déposé maintenant sur
le
site @ de RIOU ", vbOKOnly + vbInformation

menu_avip.Show
End Sub






Function cadrage(chaine As String, longueur As Integer, car As String) As
String

Dim l1 As Integer, nb_espaces As Integer

l1 = Len(chaine)
nb_espaces = longueur - l1

If nb_espaces > 0 Then
cadrage = chaine & String(nb_espaces, car)
Else: cadrage = Left(chaine, longueur)
End If

End Function

Function cadragedroite(chaine As Variant) As String

Dim l2 As Integer, nb_zero As Integer

l2 = Len(chaine)
cadragedroite = " " & String(12 - l2, "0") & chaine

End Function

Function civilite(civ As String) As String

If UCase(civ) = "SA" Then civilite = "01"
If UCase(civ) = "SARL" Then civilite = "02"
If UCase(civ) = "M" Then civilite = "03"
If UCase(civ) = "MME" Then civilite = "04"
If UCase(civ) = "MLLE" Then civilite = "05"
If UCase(civ) = "STE" Then civilite = "06"
If UCase(civ) = "ETS" Then civilite = "07"
If UCase(civ) = "ASS" Then civilite = "10"
If UCase(civ) = "" Then civilite = "11"
If UCase(civ) = "SCI" Then civilite = "13"
If UCase(civ) = "EURL" Then civilite = "14"
If UCase(civ) = "MTR" Then civilite = "15"
If UCase(civ) = "M.MME" Then civilite = "18"
If UCase(civ) = "DR" Then civilite = "20"
If UCase(civ) = "SCP" Then civilite = "22"
If UCase(civ) = "BAR" Then civilit = "07"

End Function

Function commune(cp As String) As String

' Windows("macro_fi").Activate
Set C = Worksheets("liste_villes").Columns("D").Find(cp)
commune = cadrage(C.Offset(0, -2), 30, " ")

End Function
Function insee(cp As String)

' Windows("macro_fi").Activate
On Error GoTo finf:
Set C = Worksheets("liste_villes").Columns("D").Find(cp)

insee1 = C.Offset(0, -1)
If Len(insee1) = 5 Then
insee = insee1
Else
insee = "0" & insee1
End If

' MsgBox "resultat = " & insee
finf:
If Len(cp) = 5 Then
insee = cp
Else
insee = "0" & cp
End If
End Function

Merci pour votre soutien.





--
ALF

Re..
pourrais tu essayer de remplacer cette partie de code ( située à la fin de
ta macro)
****************
principal = solde
montant_formaté = Format(principal, "#########,##0.00")

montant_formaté = montant_formaté * 100
montant = Str$(montant_formaté)
longueur = Len(montant)
partie_gauche = Left$(montant, longueur - 2)
partie_droite = Right$(montant, 2)
montant_final = partie_gauche & "," & partie_droite

montant = Mid$(montant_final, 2, Len(montant_final) - 1)
' MsgBox "resultat - montant final : " & montant & " longueur " &
Len(montant)

result = result & cadragedroite(montant)
***********************

par la seule ligne suivante :

result = result & String(12 - Len(Format(solde, "0.00")), "0") &
Format(solde, "0.00")

ça devrait le faire .....

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
8E29DACC-447F-4DB8-A101-00DF1C0442C9@microsoft.com...

Bonjour,
j'ai une macro dont une procedure (sub traitement impayes) me retourne un
fichier .xls et un fichier.txt.
le fichier .xls est ok mais le fichier.txt me renvoie un montant
erronné.il
senblerait que la macro supprime le 1er chiffre du montant ,prend la
chaine
de chiffre(limité à 5 chiffres max.) sans la virgule puis rajoute la
virgule
suivi de 2 chiffres.
ex si montant R3,13 on a dans le fichier.txt 2313,13
je n'arrive pas à trouver ce qui pose probleme dans la procedure..pouvez
vous m'eclairer...je vous laisse la macro

Sub choix()

menu_avip.Show

End Sub



Sub extraction_ACI()
'
'
Dim date_etat As String, date_aci2 As String
Const dir = "S:CONTENTIEUX_AVIPACI"
' Const DIR = "C:avipACI"

menu_avip.Hide

date_aci = InputBox("Les ACI de Quelle date doit-on extraire ?",
"ATTENTION
Saisir la date sous le format JJMMAA")
date_aci2 = Left$(date_aci, 2) & "/" & Mid(date_aci, 3, 2) & "/20" &
Right$(date_aci, 2)
' création fichier ACI _ date du jour

Workbooks.Open Filename:=dir & "matrice_ACI.xls"
Range("A2") = "ACI à saisir dans MISTRAL - " & date_aci2
nom_fich = "ACI_" & date_aci
ActiveWorkbook.SaveAs Filename:=dir & nom_fich


' traitement

Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select

Set debut = Range("B3")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next


For i = 3 To nb_lignes + 3
Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select
etat = Range("V" & i)
date_etat = Range("W" & i)

' MsgBox "etat = " & etat & " date_etat = " & date_etat & " date_aci2 > > " & date_aci2

If etat = "ACI" And date_etat = date_aci2 Then
' stockage données à copier
avip = Range("B" & i)
rev = Range("C" & i)
nom = Range("D" & i)
date_defer = Range("M" & i)
creance = Range("L" & i)
mont_payés = Range("O" & i)
solde = Range("Q" & i)
mont_ACI = Range("R" & i)
motif_ACI = Range("S" & i)
' sélection fichier ACI pour collage
Windows(nom_fich & ".xls").Activate
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("A5") = avip
Range("B5") = rev
Range("C5") = nom
Range("D5") = date_defer
Range("E5") = creance
Range("F5") = mont_payés
Range("G5") = solde
Range("H5") = mont_ACI
Range("J5") = mont_ACI / 1.196
Range("I5") = mont_ACI - mont_ACI / 1.196
Range("K5") = motif_ACI
Range("N5") = etat
Range("O5") = date_etat
Range("O5").Select
Selection.NumberFormat = "dd/mm/yy;@"


End If

Next i

Windows(nom_fich & ".xls").Activate
Set debut = Range("A5")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next

Range("A5:O" & nb_lignes + 4).Select
Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

TTC = 0
TVA = 0
HT = 0

For k = 5 To nb_lignes + 4
TTC = TTC + Range("H" & k)
TVA = TVA + Range("I" & k)
HT = HT + Range("J" & k)
Next k

Range("H" & nb_lignes + 6) = TTC
Range("I" & nb_lignes + 6) = TVA
Range("J" & nb_lignes + 6) = HT


Range("H" & nb_lignes + 6 & ":J" & nb_lignes + 6).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With

compteur = 1
compteur_avip = 0
lignes_a_traiter = nb_lignes
nb_total = nb_lignes + 10
For j = 5 To nb_total
avip = Range("A" & j)
AVIP_suivant = Range("A" & j).Offset(1, 0)


If AVIP_suivant = avip Then
compteur = compteur + 1
lignes_a_traiter = lignes_a_traiter - 1
End If

If AVIP_suivant <> avip Then

compteur_avip = compteur_avip + 1
Rows(j + 1 & ":" & j + 1).Select
Selection.Insert Shift:=xlDown
Range("H" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"
Range("I" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"
Range("J" & j + 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & -compteur & "]C:R[-1]C)"
Range("H" & j + 1 & ":J" & j + 1).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
compteur = 1
j = j + 1

End If

Next j

ActiveWorkbook.SaveAs Filename:=dir & nom_fich
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' ActiveWorkbook.Close
End Sub


Sub extraction_versement()
'
'
Dim date_etat As String, date_aci2 As String
Const dir = "S:CONTENTIEUX_AVIPRIOU"
'Const DIR = "C:avipRIOU"

menu_avip.Hide

date_RIOU = InputBox("Les Versements de Quelle date doit-on extraire ?",
"ATTENTION Saisir la date sous le format JJMMAA")
col = InputBox("Dans quelle colonne ont été saisis les paiements ? ")
date_RIOU2 = Left$(date_RIOU, 2) & "/" & Mid(date_RIOU, 3, 2) & "/20" &
Right$(date_RIOU, 2)
' création fichier Versements RIOU

Workbooks.Open Filename:=dir & "matrice_versements_RIOU.xls"
Range("A2") = "Versements RIOU du " & date_RIOU2
Range("K4") = "Vers. " & date_RIOU2
nom_fich = "Versements_RIOU_" & date_RIOU
ActiveWorkbook.SaveAs Filename:=dir & nom_fich


' traitement

Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select

Set debut = Range("B3")
Set fin = debut.End(xlDown)
Set maplage = Range(debut, fin)

' comptage nb lignes

nb_lignes = 0
For Each macellule In maplage
nb_lignes = nb_lignes + 1
Next


For i = 3 To nb_lignes + 3
Windows("suivi_dossiers_avip.xls").Activate
Sheets("AVIP").Select
date_etat = Range("W" & i)

' MsgBox "etat = " & etat & " date_etat = " & date_etat & " date_aci2 > > " & date_aci2

If date_etat = date_RIOU2 Then
' stockage données à copier
avip = Range("B" & i)
rev = Range("C" & i)
nom = Range("D" & i)
date_defer = Range("M" & i)
date_RIOU = Range("N" & i)
creance = Range("L" & i)
mont_payés = Range("O" & i)
solde = Range("Q" & i)
etat = Range("V" & i)
date_etat = Range("W" & i)
montant = Range(col & i)

' sélection fichier ACI pour collage
Windows(nom_fich & ".xls").Activate
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Range("A5") = avip
Range("B5") = rev
Range("C5") = nom
Range("D5") = creance
Range("E5") = date_defer
Range("F5") = date_RIOU
Range("G5") = mont_payés
Range("H5") = solde
Range("I5") = etat
Range("J5") = date_etat
Range("J5").Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("K5") = montant


End If