Erreur d'objet dans une macro à paramètres

Le 23/02/2018 à 16:29

Bonjour à tous,

Un petit problème de type de variable / syntaxe à vous soumettre si vous le voulez bien

Voici le code d'une macro où deux cas peuvent se produire à l'initialisation, et où la macro exécute exactement la même opération, mais dans un ensemble d'onglets qui varie selon le cas :

Désolé pour les pros du VBA, mon code est loin d'être optimisé

Sub Enregistrement_Base_de_données_Transactions()
'
' Enregistrement_Base_de_données Macro

'Sélection du cas entre 1) Moi qui enregistre et 2) L qui enregistre

Select Case ActiveSheet.Name

'Cas numéro 1 : je fais l'enregistrement

Case Is = Worksheets([Onglet_3].Value).Range("Onglet_3").Value

'Sélection totale de la plage

Application.ScreenUpdating = True
Range("C7:L26").Select

Dim Plage As Range
Set Plage = Selection
Dim i As Integer

If (Range("I7") = Empty) And (Range("I8") = Empty) And (Range("I9") = Empty) And (Range("I10") = Empty) And (Range("I11") = Empty) And (Range("I12") = Empty) And (Range("I13") = Empty) And (Range("I14") = Empty) And (Range("I15") = Empty) And (Range("I16") = Empty) And (Range("I17") = Empty) And (Range("I18") = Empty) And (Range("I19") = Empty) And (Range("I20") = Empty) And (Range("I21") = Empty) And (Range("I22") = Empty) And (Range("I23") = Empty) And (Range("I24") = Empty) And (Range("I25") = Empty) And (Range("I26") = Empty) Then
MsgBox "Vous n'avez rentré aucune transaction à enregistrer.", vbOKOnly + vbExclamation, "Attention"
Range("C7").Select
End
End If

For i = 1 To 20

    If Plage.Cells(i, 1).Value <> "" Then

    'Préparation de la base de données : insertion ligne et numéro de comptage
    Sheets([Onglet_4].Value).Select
    Rows("12:12").Select
    Selection.Insert Shift:=xlDown
    Worksheets([Onglet_4].Value).Range("D12").Value = Worksheets([Onglet_4].Value).Range("D13").Value

    'Sélection des lignes dans Enregistrement et copie sur basse de données
    Sheets([Onglet_3].Value).Select
    With Sheets([Onglet_3].Value)
    Range(.Cells(i + 6, 3), .Cells(i + 6, 12)).Select
    End With
    Selection.Copy
    Sheets([Onglet_4].Value).Select
    Range("E12:N12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Application.CutCopyMode = False

    'Sélection de la formule des flux réels et copie sur les lignes nouvellement insérées
    Range("O13").Select
    Selection.Copy
    Range("O12").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    End If
    Next i

    'Tri de la base de données par date de transaction
    Range("E12:BORNEINF_1").Select
    ActiveWorkbook.Worksheets([Onglet_4].Value).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets([Onglet_4].Value).Sort.SortFields.Add Key:=Range("E12" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets([Onglet_4].Value).Sort
        .SetRange Range("E12:BORNEINF_1")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Elimination des erreurs de décalage de ligne sur formule de flux réels
    Range("Formule_référence_1").Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    Range("C2").Select

    'Vidage des plages de données d'enregistrement
    Sheets([Onglet_3].Value).Select
    Range("C7:C26, F7:F26, G7:G26, H7:H26, I7:I26, L7:L26").Select
    Selection.ClearContents

    'Mise à jour des données préremplies
    Sheets([Onglet_1].Value).Select
    Range("H9").Select
    Selection.Copy
    Sheets([Onglet_3].Value).Select
    Range("D7:D26").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    'Récupération des bons formats de cellules pour l'usage suivant
    Worksheets([Onglet_3].Value).Range("E35").Select
    Selection.Copy
    Worksheets([Onglet_3].Value).Range("E7:E26").Select
    ActiveSheet.Paste

    Worksheets([Onglet_3].Value).Range("J35").Select
    Selection.Copy
    Worksheets([Onglet_3].Value).Range("J7:J26").Select
    ActiveSheet.Paste

    Worksheets([Onglet_3].Value).Range("K35").Select
    Selection.Copy
    Worksheets([Onglet_3].Value).Range("K7:K26").Select
    ActiveSheet.Paste

    Worksheets([Onglet_3].Value).Range("G35:I35").Select
    Selection.Copy
    Worksheets([Onglet_3].Value).Range("G7:I26").Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Worksheets([Onglet_3].Value).Range("L35").Select
    Selection.Copy
    Worksheets([Onglet_3].Value).Range("L7:L26").Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    Range("C7").Select

'Cas numéro 2 : L fait l'enregistrement

Case Is = Worksheets([Onglet_13].Value).Range("Onglet_13").Value

'Sélection totale de la plage
Application.ScreenUpdating = True
Range("C7:L26").Select

Set Plage = Selection
Dim j As Integer

If (Range("I7") = Empty) And (Range("I8") = Empty) And (Range("I9") = Empty) And (Range("I10") = Empty) And (Range("I11") = Empty) And (Range("I12") = Empty) And (Range("I13") = Empty) And (Range("I14") = Empty) And (Range("I15") = Empty) And (Range("I16") = Empty) And (Range("I17") = Empty) And (Range("I18") = Empty) And (Range("I19") = Empty) And (Range("I20") = Empty) And (Range("I21") = Empty) And (Range("I22") = Empty) And (Range("I23") = Empty) And (Range("I24") = Empty) And (Range("I25") = Empty) And (Range("I26") = Empty) Then
MsgBox "Vous n'avez rentré aucune transaction à enregistrer.", vbOKOnly + vbExclamation, "Attention"
Range("C7").Select
End
End If

For j = 1 To 20

    If Plage.Cells(j, 1).Value <> "" Then

    'Préparation de la base de données : insertion ligne et numéro de comptage
    Sheets([Onglet_12].Value).Select
    Rows("12:12").Select
    Selection.Insert Shift:=xlDown
    Worksheets([Onglet_12].Value).Range("D12").Value = Worksheets([Onglet_12].Value).Range("D13").Value

    'Sélection des lignes dans Enregistrement et copie sur basse de données
    Sheets([Onglet_13].Value).Select
    With Sheets([Onglet_13].Value)
    Range(.Cells(j + 6, 3), .Cells(j + 6, 12)).Select
    End With
    Selection.Copy
    Sheets([Onglet_12].Value).Select
    Range("E12:N12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Application.CutCopyMode = False

    'Sélection de la formule des flux réels et copie sur les lignes nouvellement insérées
    Range("O13").Select
    Selection.Copy
    Range("O12").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    End If
    Next j

    'Tri de la base de données par date de transaction
    Range("E12:BORNEINF_2").Select
    ActiveWorkbook.Worksheets([Onglet_12].Value).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets([Onglet_12].Value).Sort.SortFields.Add Key:=Range("E12" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets([Onglet_12].Value).Sort
        .SetRange Range("E12:BORNEINF_2")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Elimination des erreurs de décalage de ligne sur formule de flux réels
    Range("Formule_référence_2").Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    Range("C2").Select

    'Vidage des plages de données d'enregistrement
    Sheets([Onglet_13].Value).Select
    Range("C7:C26, F7:F26, G7:G26, H7:H26, I7:I26, L7:L26").Select
    Selection.ClearContents

    'Mise à jour des données préremplies
    Sheets([Onglet_14].Value).Select
    Range("H9").Select
    Selection.Copy
    Sheets([Onglet_13].Value).Select
    Range("D7:D26").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    'Récupération des bons formats de cellules pour l'usage suivant
    Worksheets([Onglet_13].Value).Range("E35").Select
    Selection.Copy
    Worksheets([Onglet_13].Value).Range("E7:E26").Select
    ActiveSheet.Paste

    Worksheets([Onglet_13].Value).Range("J35").Select
    Selection.Copy
    Worksheets([Onglet_13].Value).Range("J7:J26").Select
    ActiveSheet.Paste

    Worksheets([Onglet_13].Value).Range("K35").Select
    Selection.Copy
    Worksheets([Onglet_13].Value).Range("K7:K26").Select
    ActiveSheet.Paste

    Worksheets([Onglet_13].Value).Range("G35:I35").Select
    Selection.Copy
    Worksheets([Onglet_13].Value).Range("G7:I26").Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Worksheets([Onglet_13].Value).Range("L35").Select
    Selection.Copy
    Worksheets([Onglet_13].Value).Range("L7:L26").Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    Range("C7").Select

'
End Select
End Sub

Et pour la beauté de la forme, pour optimiser le code, je cherche à remplacer les noms d'onglets tels que "Onglet_4" et d'autres noms de cellules par une variable qui selon le cas prendra une valeur ou bien l'autre. Le but est de diviser le code par 2 sans avoir à répéter toute la procédure.

Exemple : ma variable VBA "Onglet_A" prendra dans le premier cas la valeur "Onglet_4" et dans le second "Onglet_12"., ce qui évite d'écrire le code pour chaque cas individuellement.

(J'ai utilisé des noms d'onglets faisant référence à une cellule qui affiche le nom de l'onglet en permanence via une formule afin que la macro soit robuste aux changements de noms d'onglets.)

Voici le code que je suis parvenu à faire pour l'instant :

Sub Enregistrement_Base_de_données_Transactions()
'
' Enregistrement_Base_de_données Macro

' Variables :
Dim Plage As Range
Set Plage = Selection
Dim i As Integer
Dim Onglet_A As String
Dim Onglet_B As String
Dim Onglet_C As String
Dim BorneInf As String
Dim FormuleRéférence As String

' Arrêt immédiat de la macro si aucune transaction n'est entrée :
If (Range("I7") = Empty) And (Range("I8") = Empty) And (Range("I9") = Empty) And (Range("I10") = Empty) And (Range("I11") = Empty) And (Range("I12") = Empty) And (Range("I13") = Empty) And (Range("I14") = Empty) And (Range("I15") = Empty) And (Range("I16") = Empty) And (Range("I17") = Empty) And (Range("I18") = Empty) And (Range("I19") = Empty) And (Range("I20") = Empty) And (Range("I21") = Empty) And (Range("I22") = Empty) And (Range("I23") = Empty) And (Range("I24") = Empty) And (Range("I25") = Empty) And (Range("I26") = Empty) Then
MsgBox "Vous n'avez rentré aucune transaction à enregistrer.", vbOKOnly + vbExclamation, "Attention"
Range("C7").Select
End
End If

'Sélection du cas entre 1) Moi qui enregistre et 2) L qui enregistre
Select Case ActiveSheet.Name

'Cas numéro 1 : je fais l'enregistrement
Case Is = Worksheets([Onglet_3].Value).Range("Onglet_3").Value

    Onglet_A = "Onglet_4"
    Onglet_B = "Onglet_3"
    Onglet_C = "Onglet_1"
    BorneInf = "BORNEINF_1"
    FormuleRéférence = "Formule_référence_1"

'Cas numéro 2 : L fait l'enregistrement
Case Is = Worksheets([Onglet_13].Value).Range("Onglet_13").Value

    Onglet_A = "Onglet_12"
    Onglet_B = "Onglet_13"
    Onglet_C = "Onglet_14"
    BorneInf = "BORNEINF_2"
    FormuleRéférence = "Formule_référence_2"

End Select

'1) Sélection totale de la plage
Application.ScreenUpdating = True
Range("C7:L26").Select

'2) Sélection des transactions "non vides" :
For i = 1 To 20

    If Plage.Cells(i, 1).Value <> "" Then

    'A) Préparation de la base de données : insertion ligne et numéro de comptage
    Sheets(["Onglet_A"].Value).Select
    Rows("12:12").Select
    Selection.Insert Shift:=xlDown
    Worksheets(["Onglet_A"].Value).Range("D12").Value = Worksheets(["Onglet_A"].Value).Range("D13").Value

    'B) Sélection des lignes dans Enregistrement et copie sur basse de données
    Sheets(["Onglet_B"].Value).Select
    With Sheets(["Onglet_B"].Value)
    Range(.Cells(i + 6, 3), .Cells(i + 6, 12)).Select
    End With
    Selection.Copy
    Sheets(["Onglet_A"].Value).Select
    Range("E12:N12").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Application.CutCopyMode = False

    'C) Sélection de la formule des flux réels et copie sur les lignes nouvellement insérées
    Range("O13").Select
    Selection.Copy
    Range("O12").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    End If
    Next i

    'Tri de la base de données par date de transaction
    Range("E12:[BorneInf]").Select
    ActiveWorkbook.Worksheets(["Onglet_A"].Value).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(["Onglet_A"].Value).Sort.SortFields.Add Key:=Range("E12" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets(["Onglet_A"].Value).Sort
        .SetRange Range("E12:[BorneInf]")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Elimination des erreurs de décalage de ligne sur formule de flux réels
    Range("[FormuleRéférence]").Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    Range("C2").Select

    'Vidage des plages de données d'enregistrement
    Sheets(["Onglet_B"].Value).Select
    Range("C7:C26, F7:F26, G7:G26, H7:H26, I7:I26, L7:L26").Select
    Selection.ClearContents

    'Mise à jour des données préremplies
    Sheets(["Onglet_C"].Value).Select
    Range("H9").Select
    Selection.Copy
    Sheets(["Onglet_B"].Value).Select
    Range("D7:D26").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    'Récupération des bons formats de cellules pour l'usage suivant
    Worksheets(["Onglet_B"].Value).Range("E35").Select
    Selection.Copy
    Worksheets(["Onglet_B"].Value).Range("E7:E26").Select
    ActiveSheet.Paste

    Worksheets(["Onglet_B"].Value).Range("J35").Select
    Selection.Copy
    Worksheets(["Onglet_B"].Value).Range("J7:J26").Select
    ActiveSheet.Paste

    Worksheets(["Onglet_B"].Value).Range("K35").Select
    Selection.Copy
    Worksheets(["Onglet_B"].Value).Range("K7:K26").Select
    ActiveSheet.Paste

    Worksheets(["Onglet_B"].Value).Range("G35:I35").Select
    Selection.Copy
    Worksheets(["Onglet_B"].Value).Range("G7:I26").Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Worksheets(["Onglet_B"].Value).Range("L35").Select
    Selection.Copy
    Worksheets(["Onglet_B"].Value).Range("L7:L26").Select
    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    Range("C7").Select

End Sub

Mais je me suis planté dans la syntaxe de mes variables, et je ne comprends pas comment la résoudre. J'ai essayé de remplacer les data type de String en Object mais ça plante toujours.

De plus, je ne vois pas comment gérer la syntaxe d'une variable telle que Onglet_A quand celle-ci apparaît dans un contexte comme celui-ci :

Worksheets(["Onglet_B"].Value).Range("J35").Select

où pour que ça marche, le nom doit apparaître entre [ ] pour fonctionner. Il marche dans le premier code mais pas dans le second.

Ainsi, je suppose que c'est juste un petit problème de type de variable et de syntaxe.

Je suis preneur de toutes vos recommandations concernant ce problème, ainsi que vos idées pour optimiser ce code davantage

Un chaleureux merci et bon weekend à tous !

Le 24/02/2018 à 14:40

Bonjour,

Merci de joindre un fichier à ta demande.

Cdlt.

Le 25/02/2018 à 19:38

Merci beaucoup Jean-Eric !

Voici le fichier avec la macro en question. Ici tu as le code non optimisé de la macro et je souhaite appliquer un équivalent du code proposé au message précédent, mais qui marche ^^

En somme, dans le select case je réécris toutes les opérations d'un cas à l'autre, alors que j'aimerais faire un select case dans lequel dans chaque cas on fixe les valeurs des variables, et ensuite on déroule les opérations une seule fois avec les variables en question.

Tous tes conseils sont bons à prendre

Merci et bonne soirée !

12modele-code-initial-excel-pratique.xlsm (101.00 Ko)

Le 25/02/2018 à 19:44

Re,

Si tu veux une aide du forum, commence par supprimer le protection.

Cdlt.

Le 26/02/2018 à 07:55

My bad :-p cette fois c'est bon

17modele-code-initial-excel-pratique.xlsm (75.63 Ko)

Le 26/02/2018 à 10:28

Bonjour,