Soyez le premier à donner votre avis sur cette source.
Snippet vu 7 450 fois - Téléchargée 18 fois
'Exemple 'sur le réseau on a les 2 Répertoires : ' => CheminSource & Source.xls : fichier source.xls (date à changer...) ' => CheminTemp & MajSource.xls : fichier MajSource.xls (rep de travail) 'sur les postes utilisateurs on a les 2 fichiers : ' => CheminUser & Source.xls ' => CheminUser & MajUser.xls : fichier MajUser.xls (rep de travail) '*************************************************************** 'Au Réseau : Dans le CLASSEUR DE TRAVAIL (MajSource.xls) '*************************************************************** 'dans ThisWorkbook Private Sub Workbook_Open() Application.ScreenUpdating = False 'masque les écrans intermédiaires SourceMaJ 'lance la mise à jour de la date de création initiale ThisWorkbook.Save i = Workbooks.Count 'comptage des classeurs ouverts (autres applications Excel en cours) If i < 2 Then 'si c'est la seule application Excel ouverte Application.Quit 'quitte l'application (ferme Excel) Else 's'il y a d'autres fichiers Excel ouverts, ActiveWorkbook.Close 'ferme seulement le fichier (sans fermer les autres) End If End Sub '*************************************************************** 'dans un module Sub SourceMaJ() 'Change la date de création initiale Application.ScreenUpdating = False 'masque les écrans intermédiaires Dim fs, f1, f2 Dim FF As Integer Dim strNewFile As String Dim strTempFile As String FilePath1 = "\\CheminSource\" 'chemin réseau de la source FilePath2 = "\\CheminTemp\" 'chemin réseau du répertoire de travail Filename = "Source.xls" 'nom du fichier source Set fs = CreateObject("Scripting.FileSystemObject") 'copie de la source dans le répertoire d'échange (même nom) fs.CopyFile FilePath1 & Filename, FilePath2 & Filename On Error Resume Next strNewFile = FilePath1 & Filename 'chemin source nouvelle date SetAttr strNewFile, vbNormal 'si traitement en mode caché strTempFile = FilePath1 & "Temp" & Filename 'Chemin source temporaire SetAttr strTempFile, vbNormal 'si traitement en mode caché strOldFile = FilePath2 & Filename 'Chemin source ancienne date SetAttr strOldFile, vbNormal 'si traitement en mode caché 'supprime la Source ancienne date dans Chemin Source If Dir(strNewFile) <> "" Then Kill (strNewFile) 'Création fichier source temporaire vide FF = FreeFile() Open strTempFile For Output As #FF 'ouvre à valeur 0 octets Close #FF 'et ferme la source copiée 'recopie la Source (vide) avec nouvelle date sur chemin Source FileCopy strTempFile, strNewFile 'supprime la source temporaire vide Kill strTempFile '*************************************************************** 'écrase la source vide nouvelle date par la source ancienne date '=> Cette opération de change PAS la date de création ! '*************************************************************** Set f1 = fs.GetFile("\\CheminTemp\Source.xls") Set f2 = fs.GetFile("\\CheminSource\Source.xls") fs.CopyFile f1, f2, True SetAttr f2, vbHidden 'si traitement en mode caché Kill (f1) 'supprime la source ancienne date End Sub '*************************************************************** 'A ce niveau, le fichier Source recoit une nouvelle date de création (date et heure du traitement par MajSource.xls) 'Il est alors possible de comparer avec les dates de création des Source Utilisateurs '*************************************************************** 'Sur le Poste Utilisateur : Dans le CLASSEUR SOURCE (Source.xls) '*************************************************************** 'dans Thisworkbook Private Sub Workbook_Open() Dim fs, f1, f2, f3, s1, s2 FilePath1 = "\\CheminSource\" 'chemin réseau de la source FilePath2 = "CheminUser\" 'chemin de la source sur le Poste User FilePath3 = "CheminUser\" 'chemin du répertoire de travail User FilenameS = "Source.xls" FilenameU = "MajUser.xls Set fs = CreateObject("Scripting.FileSystemObject") 'Reprend la date de création du fichier Source réseau Set f1 = fs.GetFile(FilePath1 & FilenameS) s1 = f1.DateCreated 'Reprend la date de création du fichier Source Utilisateur Set f2 = fs.GetFile(FilePath2 & FilenameS) s2 = f2.DateCreated 'si la date Source User est trop ancienne, Start User est mis à jour par le classeur MajUser.xls If s1 > s2 Then Workbooks.Open(FilePath3 & FilenameU) Workbooks(FilenameS).close savechanges:=false End if End sub '*************************************************************** 'Sur le Poste Utilisateur : Dans le CLASSEUR MajUser (MajUser.xls) '*************************************************************** Private Sub Workbook_Open() FilePath1 = "\\CheminSource\" 'chemin réseau de la source FilePath2 = "CheminUser\" 'chemin de la source sur le Poste User FilePath3 = "CheminUser\" 'chemin du répertoire de travail User FilenameS = "Source.xls" Dim f1, f2 f1 = FilePath1 & FilenameS f2 = FilePath2 & FilenameS copy f1,f2, true ThisWorkbook.Save i = Workbooks.Count 'comptage des classeurs ouverts (autres applications Excel en cours) If i < 2 Then 'si c'est la seule application Excel ouverte Application.Quit 'quitte l'application (ferme Excel) Else 's'il y a d'autres fichiers Excel ouverts, ActiveWorkbook.Close 'ferme seulement le fichier (sans fermer les autres) End If
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.