ARCHIVAGE DONNEES DANS FICHIER SYNTHESE

[TITICOOL]

Bonjour,

Je suis un débutant.
J'ai développé une petite routine pour créer, à partir d'un fichier de base, des factures avec incrémentation du numéro et sauvegarde vers un répertoire facture précis.

Voici le code:

Private Sub Workbook_Open()
'
' test1 Macro
' Macro enregistrée le 24/01/2003 par Th. GEORGES

Dim nom_fichier As String
Dim num_facture As String
Dim jour As String
Dim num_client As String

Range('J4').Value = Range('J4').Value + 1 'incrémente numéro facture
ActiveWorkbook.Save

jour = InputBox('Entre la date:', 'Date:')
num_client = InputBox('Entre le numéro de client:', 'Numéro client:')
num_facture = Range('J4')
Range('J5') = jour
Range('I7') = num_client
nom_fichier = '2003_' & num_facture & '.xls'

Sheets('Feuil1').Copy 'copie la feuil1 dans le presse-papiers avant de sauver
ChDir 'c:\\stephane\\factures\\'
ActiveWorkbook.SaveAs Filename:=nom_fichier
ActiveWorkbook.Close
Application.DisplayAlerts = False
Application.Quit

End Sub

J'aimerais améliorer cette macro afin d'archiver certaines infos de chaque facture vers un fichier de synthèse.
Le but serait d'envoyer lors de la créatoin de la facture les données des cellules suivantes vers le fichier synthèse:

H4:I4 vers première cellule vide colonne A
J4 vers première cellule vide colonne B
J5 vers première cellule vide colonne C
I8 vers première cellule vide colonne D
J8 vers première cellule vide colonne E
I9:J9 vers première cellule vide colonne F
I12 vers première cellule vide colonne G
J53:J54 vers première cellule vide colonne H

A noter :les cellules avec 2 points sont des cellules fusionnées et il y a des cellules liées à un fichier client. Donc, prendre en compte la valeur seulemnt de la cellule.

J'ai essayé en bidouillant avec la création de macro et en copiant les lignes de codes obtenues mais je n'ai rien eu de convainquant.

Quelqu'un pourrait-il m'aider?

J'ai également tout un tas de factures déjà créées dont je voudrais lister les mêmes informations.
Est-il possible de passer tout le répertoire en revue sans ouvrir les fichiers et archiver toutes les infos précédemment citées?

Merci d'avance de vos avis.

A bientôt

Titicool [file name=2003_365.zip size=28948]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/2003_365.zip[/file]

 

[tontoncarton]

salut titicool

J'ai peut etre une solution pour toi.Je pense que le mieux c'est d'archiver les donnees de ta facture au moment ou tu l'enregistre.

Tu crees une feuille 'Fact'

Dim l As Integer

With Sheets('Fact').Activate

l = Sheets('Fact').Range('A65536').End(xlUp).Row + 1

Cells(l, 1) = H4:I4 vers première cellule vide colonne A de la feuille fact
Cells(l, 2) = J4 vers première cellule vide colonne B de la feuille fact

et ainsi de suite...

par contre si les cellule h4 et i4 sont fusionner alors tu n'as pas a mettre les 2 celulles juste le nom de l'unique cellule puisque elle est fusionner.

Voila , donc ca pourrai donner un truc comme ca :

cells(l,1)= sheets('cequetuveux').range('h4')

allez @ +

 

[TITICOOL]

MERCI beaucoup à toi de cette réponse rapide.

Je vais tester ta solution.


A bientôt

Titicool

 

[TITICOOL]

Tout d'abord merci, merci beaucoup TONTONCARTON.

Tes idées ont permis de réaliser l'archivage mais le poblème est que tout reste dans une feuille de mon fichier de création des factures.
Ce fichier lance un macro au démarrage et le fichier est fermé ainsi qu'excel en fin de macro.

Il faut donc ouvrir le fichier sans activer les macros et consulter les archives. Pas très sympa.

Pour envoyer toute ces données vers un nouveau fichier.
Faut-il utiliser une fonction du style workbook avec le nom du fichier vers lequel je veux envoyer les données?

Workbook('nom fichier').sheets('nomfeuil').range('xx')

Merci d'avance de vos conseils.

TITICOOL

 

[tontoncarton]

salut titicool

Je suis content d'avoir reussi a t'aider .Je ne comprends pas vraiment le probleme avec cette macro qui ferme tout mais pourkoi ne pas utiliser une methode copier coller de ta feuille dans un nouveau classeur ?

With Sheets('feuille a copier ').Activate
Worksheets('Feuille a copier ').Range('A:I').Copy

Workbooks.Open ('C:\\destination\\classeur.xls')
Sheets('feuille a coller').Range('A:I').PasteSpecial
ActiveWorkbook.Save
ActiveWorkbook.Close
End With

voila j'espere que ca ira sinon réxplique moi le probleme de cette macro pour consulter les archives

@+

 

[TITICOOL]

Salut Tontoncarton,

Merci de ta réponse rapide.

Je pense que c'est exactement ce qu'il me faut.

A+
Titicool

 

[TITICOOL]

Salut Tontoncarton et les excelliens.

Tout va bien?
Moi ça va.

Je me remets un peu dans le bain et j'ai essayé la solution proposée.
Cela ne fonctionne pas correctement.
Voici le bout de code de l'essai:

'-------------------archivage extérieur----------
'ajout transfert archivage vers fichier extérieur
'------------------------------------------------
test 1
'With Sheets('Archives').Activate
'Worksheets('Archives').Range('A:I').Copy
'
'Workbooks.Open ('C:\\Archives1.xls')
'Sheets('Archives').Range('A:I').PasteSpecial
'ActiveWorkbook.Save
'ActiveWorkbook.Close
'End With
test2
'-------------------archivage extérieur----------
With Sheets('Archives').Activate
    Columns('A:I').Copy
    ChDir 'C:\\'
    Workbooks.Open Filename:='C:\\Archives1.xls'
    Columns('A:I').Select
    ActiveSheet.PasteSpecial
'    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
End With
'-------------------archivage extérieur----------

Actuellement, l'archivage est correst dans le fichier d'origine mais le transfert vers le fichier Archives1 (feuille Archives1) ne se fait pas du tout.

Je joins également le code complet afin que vous saissisiez toute la démarche de ma routine.

Titicool [file name=code_20051003165336.zip size=966]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/code_20051003165336.zip[/file]

 

[titicool]

Salut les excelliens,

Je me permets de relancer ce fil car je tiens à finaliser ce projet que j'ai démarré il y a un bout de temps.
Je l'ai remplacé provisoirement par une autre solution.

Si quelqu'un peut m'aiguiller, je continue à checker de mon côté bien sûr.

Titicool

 

[TITICOOL]

Bonjour Excelliennes, Excelliens,

Je me permets de relancer ce fil de nouveau car je n'ai pas réussi à réaliser ce que je voulais.
Je n'arrive pas à copier la feuille où j'archive mes données vers un autre fichier.

Si quelqu'un peut regarder le code que j'ai déjà posté dans un post précédent.

Merci d'avance.

Titicool

 

[titicool]

Bonjour excelliennes, excelliens.

De nouveau, je me permets de relancer le fil.
Comme expliquer plus haut, je n'arrive pas à copier ma feuille d'archivage vers un autre classeur fermé.

Quelqu'un peut-il m'aiguiller, car j'ai testé les solutions proposées mais sans résultat convainquant.

Merci d'avance.

Titicool.

 

[MichelXld]

bonjour

tu peux tester une macro de ce type

Private Sub CommandButton1_Click()
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Fichier As String, Cible As String, Feuille As String

Fichier = 'C:\\\\\\\\\\fichierFerme.xls'
'nom de la feuille dans le classeur fermé
Feuille = 'Feuil1$' 'attention a ne pas oublier le '$'
Set Cn = New ADODB.Connection
Cn.Open 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
'data source=' & Fichier & ';' & _
'extended properties=''Excel 8.0;'''

Cible = 'SELECT * FROM [' & Feuille & '];'

Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic

With Rs
.AddNew
.Fields(0) = Range('H4')
.Fields(1) = Range('J4')
.Fields(2) = Range('J5')
.Fields(3) = Range('I8')
.Fields(4) = Range('J8')
.Fields(4) = Range('I9')
.Fields(4) = Range('I12')
.Fields(4) = Range('J53')
.Update
End With

Rs.Close
Cn.Close
End Sub


un exemple qui utilise un Userform dans ce lien , mais tu pourras facilement l'adapter à ton projet

Lien supprimé

Lien supprimé




bon apres midi
MichelXld

 

[titicool]

Bonjour MichelXLD,

Grand merci de a réponse.

Je démarre en VBA et j'ai regardé dans Excel pour activer la microsoft ADO library mais je ne vois vraiment pas où cela doit être configuré.

Peux-tu m'aider à ce sujet?

Merci d'avance.

Une remarque également, les données à archiver alimentent déjà une feuille dans mon classeur de création des factures. Est-il possible de simplement préciser de copier cette feuille dans le fichier fermé en fin de ma routine existante?

Grand merci de ton aide

Titicool

 

[ChTi160]

Salut titicool
bonjour le fil
bonjour michel
bonjour le Forum

si je peux me permettre d'excel, tu fais Alt+F11 et tu est dans VB et la tu fais OUTILS et Références la tu trouveras ce que tu cherches
Bonne journée
encore merci à Michel

 

[MichelXld]

bonjour Titicool , bonjour cher ami Jean-Marie

Titicool , désolé mais je ne comprends pas ta phrase

les données à archiver alimentent déjà une feuille dans mon classeur de création des factures. Est-il possible de simplement préciser de copier cette feuille dans le fichier fermé en fin de ma routine existante?

bonne soirée
MichelXld

 

[titicool]

Salut Michel XLD, salut chti160, excelliennes excelliens,

Premièrement, je n'ai pas encore eu le temps d'essayer la méthode que tu m'as conseillée.

Je vais essayer de me faire mieux comprendre concernant la question que tu ne comprends pas.

La routine que j'ai actuellement, et qui fonctionne correctement, archive mes factures dans une feuille contenue dans le fichier de création de mes factures.

Ce fichier lance une routine qui est dans thisworkbook et démarre à l'ouverture du fichier.
Ce fichier demande la date de la facture par inputbox et le numéro de client. Quand ces données sont encodées, il y archivage de certaines cellules dans une deuxième feuille de ce fichier de base. Ensuite le fichier Excel est fermé ainsi qu'Excel.

Donc pour lire ces archives, je dois ouvrir le fichier sans activer les macros. Ce qui m'embête u peu. J evoudrais consulter tout cela dans un fichier indépendant. C'est pour cela que je proposais de simplement copier la feuile d'archivage vers un autre fichier.

J'espère qu'après cette explication, ce sera plus clair pour toi.
A noter que le code de ma routine est un plus haut dans le fil.
La solution que tu me propose via ADo fait en fait directement l'archivage. Je vais prendre le temps de tester cela.

Merci beaucoup.

A bientôt.

Titicool