[ up ]Relance auto, problème d'impression

[Jeanbulle]

Bonjour à tous

Voila, j'ai un soucis avec le fichier que nous avions étudié auparavant.
( Relance de facture suivant un tableau excel, avec des cases ' retard ' vers une lettre type )
Car avec le code ci dessous, deux erreurs ont été découverte.

La première : La date qui s'inscris dans la case ' date de relance ' est le 02/03/06 au lieu de 03/02/06 ( grace à la commande 'now' )
Je ne trouve pas la raison.

Second problème :
Le code INSERE une nouvelle feuille, copie la feuille 'relance une', la colle sur la nouvelle feuille et importe les variables à relancer.
Le soucis est que le fait de créer une feuille ne garde par les dimensions des cases, ce qui amene une mauvaise impression.
J'ai essayé de copier la feuille ' relance une ' (au lieu de creer une feuille en collant les cellules de 'relance une ')

Mais la création se fait dans un nouveau classeur, et les variables n'y sont pas collées.


Soit, voici le code :

Sub test()
n = 0 'pour numeroter les relances
For Each c In Range('M15:M65536') 'pour chaque cellule de la colonne M attention pour des tests prevoir M10 comme limite !!!
ligne = c.Row ' je repere le numero de la ligne
If Cells(ligne, 13) = 'Retard' Then 'si la 13eme colonne est Retard
rel1 = Cells(ligne, 15) 'enregistrement en variables des renseignements qui serviront à remplir la lettre
rel2 = Cells(ligne, 16)
no = Cells(ligne, 2)
nom = Cells(ligne, 3)
adr = Cells(ligne, 4)
cp = Cells(ligne, 5)
ville = Cells(ligne, 6)
tot = Cells(ligne, 7)
restedu = Cells(ligne, 12)
ech = Cells(ligne, 10)
acompte = Cells(ligne, 8)
net = Cells(ligne, 9)
rel1 = Cells(ligne, 15)
rel2 = Cells(ligne, 16)


If rel1 = '' Then 'si la premiere relance n'a pas été faite
n = n + 1 'creation du numero de la relance
Cells(ligne, 15) = Left((Now), 10) ' mettre la date de la 1ere relance
Dim Ns As Worksheet
Set ws = Sheets.Add
'lenom = Sheets.Add.Name 'ajouter une feuille et enregistrer le nom donné par excel
With ws
Worksheets('Relance une').Cells.Copy 'copier la lettre type
.Paste ' la coller sur la feuille ajoutée
.Range('L10:Q10') = nom 'transferer les variables
.Range('K11:R11') = adr
.Range('L12:M12') = cp
.Range('N12:R12') = ville
.Range('B3031') = no
.Range('E30:G31') = ech
.Range('H30:J31') = tot
.Range('K30:M31') = acompte
.Range('N30:Q31') = restedu
.Range('L35:N35') = restedu
.Name = 'relance1_' & n 'renommer la feuille ajoutée
End With

End If

End If
If Cells(ligne, 13) = '' Then Exit For 'arret de l'examen de la colonne M
Next
Call impression1
Call suppression1
End Sub

Je souhaite trouver une solution pour que la feuille où les variables viennent se déposer, puis s'imprimer SOIT identique en impression que la feuille d'origine.

Connaitriez vous une solution ?

Merci beaucoup

 

[pierrejean]

revu le fichier
1)la date: incomprehensible
avec le format 'dd/mm/yyyy' il y a inversion de 02 et 03
j'ai utilisé un palliatif en mettant 'd-mmm-yyyy'

2)la copie des relances
chez moi cela se passe bien
j'ai tout de meme modifié le paste en
PasteSpecial Paste:=xlAll

teste et tiens moi au courant [file name=essaisuivipaiement3_20060203153925.zip size=40848]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/essaisuivipaiement3_20060203153925.zip[/file]

 

[Jeanbulle]

Bonjour,

Merci pour votre réponse.
Encore vous

J'ai essayé également, mais ca ne fonctionne pas
Je vous transmet mon fichier
Ce sera le plus simple pour que vous compreniez bien mon erreur.

Merci à vous

Erwan

Message édité par: Jeanbulle, à: 03/02/2006 17:24

 

[Jeanbulle]

Le fichier
Désolé

Fichier trop important.
Je vous le met à disposition sur le lien suivant :




Ici le fichier

Merci beaucoup

Message édité par: Jeanbulle, à: 03/02/2006 17:46

 

[Jeanbulle]

Bonjour à tous !

Désolé, je n'avais pas eu le temps de poster.
Je me suis trouvé une solution, et ce grace à vous.
J'ai simplement modifier le code.

Je le poste naturellement pour que le topic soit clot
Merci encore

Sub test()
For Each c In Range('M15:M65536') 'pour chaque cellule de la colonne M attention pour des tests prevoir M10 comme limite !!!
   ligne = c.Row ' je repere le numero de la ligne
  If Cells(ligne, 13) = 'Retard' Then 'si la 13eme colonne est Retard
   rel1 = Cells(ligne, 15) 'enregistrement en variables des renseignements qui serviront à remplir la lettre
   rel2 = Cells(ligne, 16)
   no = Cells(ligne, 2)
   nom = Cells(ligne, 3)
   adr = Cells(ligne, 4)
   cp = Cells(ligne, 5)
   ville = Cells(ligne, 6)
   tot = Cells(ligne, 7)
   restedu = Cells(ligne, 12)
   ech = Cells(ligne, 10)
   acompte = Cells(ligne, 8)
   net = Cells(ligne, 9)
   'rel1 = Cells(ligne, 15)
   'rel2 = Cells(ligne, 16)


 If rel1 = '' Then
 Cells(ligne, 15) = Format((Now), 'd-mmm-yyyy')
     With Worksheets('Relance une')
     .Range('L10:Q10') = nom 'transferer les variables
     .Range('K11:R11') = adr
     .Range('L12:M12') = cp
     .Range('N12:R12') = ville
     .Range('B30:D31') = no
     .Range('E30:G31') = ech
     .Range('H30:J31') = tot
     .Range('K30:M31') = acompte
     .Range('N30:Q31') = restedu
     .Range('L35:N35') = restedu
    Sheets('Relance une').PrintOut
    .Range('L10:Q10').ClearContents
    .Range('K11:R11').ClearContents
    .Range('L12:M12').ClearContents
    .Range('N12:R12').ClearContents
    .Range('B30:D31').ClearContents
    .Range('E30:G31').ClearContents
    .Range('H30:J31').ClearContents
    .Range('K30:M31').ClearContents
    .Range('N30:Q31').ClearContents
    .Range('L35:N35').ClearContents
     End With
         
 End If

End If
  If Cells(ligne, 13) = '' Then Exit For 'arret de l'examen de la colonne M
Next
End Sub