Simplification de code

[Victor21]

Bonsoir à tous!!!

J'aimerais profiter de vos lumières pour fiabiliser et si possible simplifier ce code, placé dans un module du classeur "Classification avec BD", qui contient, entre autres, une feuille "Saisie".

Ce code est destiné à ouvrir le classeur "Historique", à coller les données de la feuille "Saisie" du premier classeur, vers la feuille "Archives" du deuxième, à effacer les données copiées, à enregistrer et fermer le classeur "Historique.

La première partie :

Sub Archive1()

    Dim DerligSaisie As Long
    Dim DerligHisto As Long

    DerligSaisie = Range("O65536").CurrentRegion.End(xlUp).Row + 1

    Workbooks.Open Filename:=ThisWorkbook.Path & "\Sauvegardes\" & "Historique.xls"
    DerligHisto = Sheets("Archive").Range("b65536").CurrentRegion.End(xlUp).Row + 1

    Windows("Classification avec BD.xls").Activate
    Sheets("Saisie").Range("A7 :O" & DerligSaisie).Copy
    Windows("Historique.xls").Activate
    Sheets("Archive").Range("B" & DerligHisto).PasteSpecial Paste:=xlPasteValues
    Windows("Classification avec BD.xls").Activate
    Sheets("Saisie").Range("A7 :O" & DerligSaisie).SpecialCells(xlConstants).ClearContents

End Sub

Les aller-retour entre les 2 classeurs me semblent superflus. Qu'en pensez-vous ?

D'avance merci pour toute suggestion.

 

[Pierrot93]

Re : Simplification de code

Bonjour Victor,

essaye peut être ceci :

Dim DerligSaisie As Long, DerligHisto As Long, wb As Workbook
DerligSaisie = Range("O65536").CurrentRegion.End(xlUp).Row + 1
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Sauvegardes\" & "Historique.xls")
DerligHisto = wb.Sheets("Archive").Range("b65536").CurrentRegion.End(xlUp).Row + 1
With ThisWorkbook.Sheets("Saisie")
    .Range("A7 :O" & DerligSaisie).Copy
    wb.Sheets("Archive").Range("B" & DerligHisto).PasteSpecial Paste:=xlPasteValues
    .Range("A7 :O" & DerligSaisie).SpecialCells(xlConstants).ClearContents
End With

en supposant "Classification avec BD.xls" étant le classeur où se trouve le code, si ce n'est pas le cas lui affecter également une variable objet..

bonne journée
@+

 

[Victor21]

Re : Simplification de code

Bonjour, et merci beaucoup, Pierrot;

Lorsque je parle de fiabiliser le code, c'est également la gestion des erreurs (comment anticiper les mauvaises manips de l'utilisateur lorsque, par exemple, Historique est déjà ouvert, ou a été changé de répertoire, ou effacé ou ... ).
J'ai trouvé quelques bouts de code, j'essaie de les incorporer, mais tu sais bien que l'imagination des utilisateurs n'a pas de bornes pour planter un code, et je tente d'anticiper cette imagination pour "limiter les dégats".
🙂

 

[Pierrot93]

Re : Simplification de code

Re,

tu peux également "gérer" les erreurs et avertir l'utilisateur au cas ou...

Option Explicit
Sub test()
Dim DerligSaisie As Long, DerligHisto As Long, wb As Workbook
On Error GoTo fin
DerligSaisie = Range("O65536").End(xlUp).Row + 1
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Sauvegardes\" & "Historique.xls")
DerligHisto = wb.Sheets("Archive").Range("b65536").End(xlUp).Row + 1
With ThisWorkbook.Sheets("Saisie")
    .Range("A7 :O" & DerligSaisie).Copy
    wb.Sheets("Archive").Range("B" & DerligHisto).PasteSpecial Paste:=xlPasteValues
    .Range("A7 :O" & DerligSaisie).SpecialCells(xlConstants).ClearContents
End With
Exit Sub
fin: MsgBox "Une erreur s'est produite :" & vbCrLf & Err.Description _
    & vbCrLf & "Vérifier....."
End Sub

Après, à voir beaucoup de choses peuvent être contrôlées....

bon après midi
@+

 

[Victor21]

Re : Simplification de code

Re, Pierrot.

J'ai trouvé ce code qui semble fonctionner. Je le transmets au cas où cela pourrait en intéresser d'autres :

Sub Test()
Dim i As Integer
Dim sNomWkb As String
    sNomWkb = "Historique.xls"

    i = VerifClasseur(ThisWorkbook.Path & "\Sauvegardes\" & sNomWkb)
    Select Case i
        Case 0: MsgBox "Classeur fermé."
        Case 53:
            If WOuvert(sNomWkb) = False Then
                MsgBox "Fichier introuvable"
            Else
                MsgBox "Classeur déja ouvert."
            End If
        Case 70: MsgBox "Classeur déja ouvert."
        Case Else: MsgBox "Erreur : " & i
    End Select
End Sub

Private Function VerifClasseur(Fichier As String) As Integer
Dim x As Integer

    On Error Resume Next
    x = FreeFile()

    Open Fichier For Input Lock Read As #x
    Close x

    VerifClasseur = Err.Number

    On Error GoTo 0
End Function

Private Function WOuvert(sNom As String) As Boolean
Dim Wkb As Workbook
    WOuvert = False
    For Each Wkb In Workbooks
        If Wkb.Name = sNom Then
            WOuvert = True
            Exit For
        End If
    Next Wkb
End Function