Programme de mise à jour

[Domic]

Bonsoir à tous,

Aprés avoir réaliser un fichier un (gros) fichier pour l'analyse de performance de ligne de production, il m'est apparu necessaire de réaliser un code VBA pour réaliser les mises à jours suite à des modifs ou des demandes d'évolution.

Après quelques recherve, je n'ai pas trouvé de programme pouvant réaliser ceci.

Je souhaiterai savoir si qq'un en as déja écrit un qui réponde au critère suivant :
1 - ouverture du fichier vierge (recherche dans l'arborescence)
2 - ouverture du fichier de travail (recherche dans l'arborescence)
3 - contrôle des formats de fichiers, nombres de lignes, colonnes, feuilles différentes de celles du vierge
4 - dimensionnenement du fichier vierge pour recevoir les valeurs du fichier de travail
5 - enregistrement du fichier de travail en travail.old
6 - copie des données du fichier de travail dans le fichier vierge
7 - enregistrement du fichier vierge en fichier de travail

Merci d'avance pour votre aide

Domic.

 

[Abel]

Domic, le forum,

Ais du soir, bonsoir (Walking in your footsteps est bien aussi)

Quelques éléments de réponse :


Pour recherher un fichier :

RechercheFichier = "Chemin\FichierCherché.xls"
If Dir(RechercheFichier) = "" Then
Affichage = MsgBox("Le fichier cherché n'est pas présent dans le répertoire Chemin" )
RechercheFichier = Application.GetOpenFilename("Tous les fichiers excel(*.xls), *.xls", , )
If RechercheFichier = False Then
Affichage = MsgBox("Vous allez quitter la routine." & Chr(10) & "Aucune modification ni aucun enregistrement n'ont été effectués" , 48)
GoTo LaFin
End If
End If



Pour enregistrer :

NomFichier = "Tout ce que tu veux comme nom"
NomEtChemin = "Répertoire où tu veux enregistrer\" & NomFichier

EnregistrerSous :
FichierEnregistrerSous = Application.GetSaveAsFilename(NomEtChemin, Filefilter:="Fichiers Microsoft Excel (*.xls), *.xls")
If FichierEnregistrerSous <> False Then
Affichage = MsgBox("Vous allez enregistrer " & NomFichier & " sous :" & Chr(10) & Chr(10) & FichierEnregistrerSous, , "Enregistrement du fichier")
Else
GoTo LaFin
End If

If Dir(FichierSoumissionsEnregistrerSous) <> "" Then
Affichage = MsgBox("Un fichier du même nom existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Renommez le ou supprimer le.", vbExclamation, "NDLR")
GoTo EnregistrerSous
End If

ActiveWorkbook.SaveAs Filename:=FichierEnregistrerSous, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=True

LaFin:
End sub


Un peu compliqué l'enregistrer sous mais j'avais besoin de faire des tests. J'en fais profiter.

J'espère que c'est lisible et que ça t'apportera quelques réponses.

Abel

 

[Abel]

Re,

C'est pas "Ais du soir" mais "Amis du soir".
Vous aurez corrigé.

Dans ces quelques lignes, il traine un "FichierSoumissionsEnregistrerSous" à remplacer par "FichierEnregistrerSous".

A+

Abel

 

[SIXKILLER]

Pourrait-on avoir une copie de ce fichier ?????

Sixkiller

 

[Abel]

Sixkiller, tous,

Ci-joint un exemple.

Abel.