Optimiser mon code (qui marche)

[secna]

Bonjour à tous,

Je viens vers vous après avoir fini mon code pour voir si certains de vous arrive à me l'optimiser (à me le faire tourner plus rapidement quoi) .

C'est 3 codes de workbook qui s'active : -lorsqu'on sauvegarde
-lorsqu'on ouvre
-lorsqu'on modifie une cellule
Ces 3 code on pour but de surveiller un fichier (qui contient ces codes) et de transmettre ces infos à un fichier excel autre qui sert de registre pour dire : là à tel heure lui à ouvert le fichier à modifié tant de cellule et à sauvegarder ou non le fichier

Cela sans que l'utilisateur vois le code s'executer.

La boucle with est là pour se placer dans une case vide pour ne pas réécrire par dessus .

Dans mon fichier registre j'ai en haut de chaque colone : " nom d'utilisateur" puis "date" puis "modifé" puis "nombre de modif" puis s"auvegarde" tout ca sur la meme ligne

Voici mon code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fichier As String
Dim Feuil1 As Object
fichier = "I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"

Application.ScreenUpdating = False

Workbooks.Open Filename:="I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"

Application.ActiveWorkbook.Sheets("feuil1").Range("D1").Activate

Do While Not (IsEmpty(ActiveCell))
Selection.Offset(1, 0).Select
Loop

Selection.Offset(-1, 1).Select
ActiveCell.Value = "fichier sauvegarder"

Application.ActiveWorkbook.Save
Application.ActiveWorkbook.Close

Application.ScreenUpdating = True

End Sub

Private Sub Workbook_Open()

Dim fichier As String
Dim Feuil1 As Object

fichier = "I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"

user = Environ("username")

Application.ScreenUpdating = False

Workbooks.Open Filename:="I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"

Application.ActiveWorkbook.Sheets("feuil1").Range("A1").Activate

Do While Not (IsEmpty(ActiveCell))
Selection.Offset(1, 0).Select
Loop

ActiveCell.Value = user

Selection.Offset(0, 1).Select
ActiveCell.Value = Now()

Application.ActiveWorkbook.Save
Application.ActiveWorkbook.Close

Application.ScreenUpdating = True

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim fichier As String
Dim Feuil1 As Object

fichier = "I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"

Application.ScreenUpdating = False

Workbooks.Open Filename:="I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"

Application.ActiveWorkbook.Sheets("feuil1").Range("B1").Activate

Do While Not (IsEmpty(ActiveCell))
Selection.Offset(1, 0).Select
Loop

Selection.Offset(-1, 1).Select

ActiveCell.Value = "Modification de"

Selection.Offset(0, 1).Select

ActiveCell.Value = ActiveCell.Value + 1

Application.ActiveWorkbook.Save
Application.ActiveWorkbook.Close

Application.ScreenUpdating = True

End Sub



Voilà j'espère que ce n'est pas trop indigeste et que vous pourrez m'aidez

Merci d'avance

 

[Efgé]

Re : Optimiser mon code (qui marche)

Bonjour secna

Sans exemple les réponses se font toujours attendre....
Juste en passant, quelques remarques appliquées au code BeforeSave mais valables pour l'ensemble des codes:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fichier As String
'Pourquoi déclarer la variable alors que tu ne l'utilise pas ?
Dim Feuil1 As Object
'/!\ Attention Cela ne fonctionne que si tous les utilisateurs ont le même raccourci dans leurs exeplorateurs Windows
'Si tu travail en réseau, il est nécessaire d'indiquer le chemin complet deouis le serveur:
'Exemple \\Serveur1\Dossier1\SousDossier1\ etc....
'Tous le monde n'a pas les mêmes raccourcis d'explorateur
fichier = "I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"
Application.ScreenUpdating = False
'Tu as dèjas déclarer la variable fichier. Pourquoi remettre le chemin du classeur?
'Workbooks.Open Filename:="I:\Process NOVA Fonte\Service procédés\Privé\Enduits\validation enduit eau Z5\Dossier Projet Validation\Docs projets\fichier registre.xls"
Workbooks.Open Filename:=fichier
'Ici on peux optimiser (Les lignes suivies de *** sont réduites)
'Application.ActiveWorkbook.Sheets("feuil1").Range("D1").Activate '***
'Do While Not (IsEmpty(ActiveCell)) '***
'Selection.Offset(1, 0).Select '***
'Loop '***
'Selection.Offset(-1, 1).Select '***
'ActiveCell.Value = "fichier sauvegarder" '***
With ActiveWorkbook.Sheets("feuil1")
    .Range("D" & .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row).Value = "fichier sauvegarder"
End With
'Nul besoin d'Application ni de redondance
'Application.ActiveWorkbook.Save
'Application.ActiveWorkbook.Close
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub

P.S Merci d'utiliser la balise code dans tes posts (aller en mode avancé, cliquer sur l'icone code ( # ) et coller le code:
[code ]Le code[ /code]
Cela reste plus facile à lire pour tous (l'ajout de couleurs n'était pas une réussite... )
Cordialement

 

[secna]

Re : Optimiser mon code (qui marche)

Merci de ton aide

 

[secna]

Re : Optimiser mon code (qui marche)

With ActiveWorkbook.Sheets("feuil1")
.Range("D" & .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row).Value = "fichier sauvegarder"
End With
Tu peux m'expliquer le détail de ce code ? je comprend pas ce qu'il dit ...

 

[Efgé]

Re : Optimiser mon code (qui marche)

Bonjour secna

J'ai fait ce code en relisant le tiens. On peux le raccourcir:

With ActiveWorkbook.Sheets("feuil1")
    .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = "fichier sauvegarder"
End With

Les explications:

Avec la feuille1 du classeur actif (après tous les range précédés d'un point seront rattachés à cette feuille
With ActiveWorkbook.Sheets("feuil1")

On va chercher la dernière cellule remplie en colonne D (4) en partant de la dernière ligne (Rows.count) et en remontant (xlup)
Tu notera le point devant Cells qui rattache la cellule à la feuille1
.Cells(Rows.Count, 4).End(xlUp)

Pour trouver la cellule du dessous on se déplace d'une ligne et pas de colonne ( Offset(1, 0) )
.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)

On dis que l'on va changer la valeur de cette cellule ( Value = )
.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value =

On donne le texte de la cellule ( "fichier sauvegarder" )
.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = "fichier sauvegarder"

On arrête d'utiliser la feuille 1
End With

Cordialement