Macro pour modifier une ligne dans code VBA

virginie00035 · 30 Mars 2011

Bonjour à tous,
D'habitude, je trouve toujours la solution à mon problème en fouillant sur ce site, mais là je bloque faute de compétences aussi sûrement...
J'ai créé il y a quelques années un classeur comprenant des feuilles d'activités mensuelles de suivi d'enfants. Ce classeur a été dupliqué 90 fois (un fichier par enfant). J'avais également incorporé un bouton qui permet d'effacer l'ensemble des activités de l'année quand une nouvelle redémarrait.
Seulement, j'ai dû modifier récemment les tableaux d'activités et maintenant, le code du bouton n'est plus bon puisqu'il ne prend pas en compte les nouvelles cellules à effacer.
Voici l'actuel code :
Sub EFFACER_ACTIVITES()
'
' EFFACER_ACTIVITES Macro
'
Sheets(Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")). _
Select
Sheets("01").Activate
ActiveWindow.SmallScroll Down:=17
ActiveWindow.SmallScroll ToRight:=2
Range("D26:N32,D34:N40").Select
Range("D34").Activate
ActiveWindow.SmallScroll Down:=15
Range("D26:N32,D34:N40,D42:N47,D49:N51,D53:N54,D56:N56,D58:N60").Select
Range("D58").Activate
ActiveWindow.SmallScroll Down:=14
Range("D26:N32,D34:N40,D42:N47,D49:N51,D53:N54,D56:N56,D58:N60,D62:N63,D65:N67" _
).Select
Range("D65").Activate
Selection.ClearContents
Sheets("ANNEE").Select
End Sub

En ligne 19 de ce code, je voudrais pouvoir incorporer la plage AH47:BL47.
J'ai écrit ça, mais ça ne fonctionne pas

Dim LigneAModifier As Long
'With ThisWorkbook.VBProject.VBComponents("Module8").CodeModule
'LigneAModifier = .ProcBodyLine("EFFACER_ACTIVITES", vbext_pk_Proc) + 1
'.DeleteLines 19, 1
'.InsertLines 19, 1
'Range("D26:N32,D34:N40,D42:N47,D49:N51,D53:N54,D56:N56,D58:N60,D62:N63,D65:N67,AH47:BL47").Select
'End With

Pouvez-vous m'aider ?
Virginie

bond · 30 Mars 2011

Re : Macro pour modifier une ligne dans code VBA

La lecture serait plus simple avec l'utilisation des balises de code :
Aller en mode avancé...

Toute cette partie du code ne sert à rien

Code:

ActiveWindow.SmallScroll Down:=17
ActiveWindow.SmallScroll ToRight:=2
Range("D26:N32,D34:N40").Select
Range("D34").Activate
ActiveWindow.SmallScroll Down:=15
Range("D26:N32,D34:N40,D42:N47,D49:N51,D53:N54,D56 :N56,D58:N60").Select
Range("D58").Activate
ActiveWindow.SmallScroll Down:=14

Ce que tu voudrais, c'est ça 😕

Code:

Sub EFFACER_ACTIVITES()
'
' EFFACER_ACTIVITES Macro
'
Sheets(Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")). _
Select
Sheets("01").Activate
Range("D26:N32,D34:N40,D42:N47,D49:N51,D53:N54,D56 :N56,D58:N60,D62:N63,D65:N67,AH47:BL47").Select
Range("D65").Activate
Selection.ClearContents
Sheets("ANNEE").Select
End Sub

Je ne sais pas corriger la solution que tu as écrite, mais s'il s'agit d'intervenir sur 90 fichiers, je suggérerais de déplacer le code dans un fichier d'utilitaires qui comprendrait la procédure d'effacement, et pourrait être complété par d'autres opérations récurrentes sur ces fichiers... ça aurait surtout l'avantage de pouvoir mettre à jour facilement - à un seul endroit - le code qui fonctionne pour tous les fichiers.

j'ai dû modifier récemment les tableaux d'activités

90 fois ??? et la macro associée a été oubliée, c'est ça ?

virginie00035 · 30 Mars 2011

Re : Macro pour modifier une ligne dans code VBA

Bonjour,
Merci pour ta réponse et je prends note de tes corrections.
La macro n'a pas été oubliée, mais elle doit être corrigée puisque les tableaux de chaque feuille ont évolué.
L'idée d'un fichier utilitaire unique, j'y avais effectivement pensé mais cela suppose de l'ouvrir à chaque fois qu'un classeur doit être réactualisé.
Merci encore

kjin · 30 Mars 2011

Re : Macro pour modifier une ligne dans code VBA

Bonjour,
La macro simplifiée donne...

Code:

Sub EFFACER_ACTIVITES()
For i = 1 To 12
  With Sheets(Format(i, "00"))
    .Range("D26:N32,D34:N40,D42:N47,D49:N51," _
    & "D53:N54,D56:N56,D58:N60,D62:N63,D65:N67,AH47:BL47").ClearContents
  End With
Next
End Sub

...je te propose donc par macro, de supprimer complétement l'ancienne procédure "EFFACER_ACTIVITES" et de la remplacer par celle ci-dessus
Dans un module standard

Code:

Sub RemplacerMacro()
Dim code$, wbk As Workbook, deb&, fin&
Application.ScreenUpdating = False
code = code & "Sub EFFACER_ACTIVITES()" & vbCrLf
code = code & "For i = 1 To 12" & vbCrLf
code = code & "  With Sheets(Format(i, ""00""))" & vbCrLf
code = code & "    .Range(""D26:N32,D34:N40,D42:N47,D49:N51,"" _" & vbCrLf
code = code & "    & ""D53:N54,D56:N56,D58:N60,D62:N63,D65:N67,AH47:BL47"").ClearContents" & vbCrLf
code = code & "  End With" & vbCrLf
code = code & "Next" & vbCrLf
code = code & "End sub" & vbCrLf
Set wbk = Workbooks.Open("C:\xxx\....\xxxxx.xls") ' à adapter
With wbk
    If ModuleExists(wbk, "Module8") And ProcedureExists(wbk, "EFFACER_ACTIVITES", "Module8") Then
        With .VBProject.VBComponents("Module8").CodeModule
            debut = .ProcStartLine("EFFACER_ACTIVITES", vbext_pk_Proc)
            fin = .ProcCountLines("EFFACER_ACTIVITES", vbext_pk_Proc)
            .deleteLines debut, fin
            .AddFromString code
        End With
        .Close True
    Else
        .Close False
    End If
End With
Application.ScreenUpdating = True

End Sub

'Chip Pearson
Function ModuleExists(wb As Workbook, ModuleName As String) As Boolean
On Error Resume Next
ModuleExists = Len(wb.VBProject.VBComponents(ModuleName).Name) <> 0
End Function

'Chip Pearson
Function ProcedureExists(wb As Workbook, ProcedureName As String, ModuleName As String) As Boolean
On Error Resume Next
If ModuleExists(wb, ModuleName) = True Then
    ProcedureExists = wb.VBProject.VBComponents(ModuleName) _
        .CodeModule.ProcStartLine(ProcedureName, 0) <> 0
End If
End Function

Note
- que le fichier est modifié uniquement si le "module8" et la macro "EFFACER_ACTIVITES" existent
- qu'il faudrait boucler sur l'ensemble des fichiers à modifier, mais nous n'avons pas suffisamment d'infos pour t'aiguiller
- qu'on pourrait aussi exporter le code et le réimporter dans un nouveau module dans chacun de tes classeurs
A+
kjin

bond · 30 Mars 2011

Re : Macro pour modifier une ligne dans code VBA

Joli code kjin !
Je le garde en bibliothèque.

Virginie, pour continuer sur ma suggestion,

L'idée d'un fichier utilitaire unique, j'y avais effectivement pensé mais cela suppose de l'ouvrir à chaque fois qu'un classeur doit être réactualisé.

lorsque j'évoquais "pourrait être complété par d'autres opérations récurrentes sur ces fichiers...", il y a par exemple leur ouverture. L'utilitaire pourrait être utilisé comme une télécommande de fonctionnalités : Ouverture fichier, Ouverture & effacement, Effacement fichier ouvert,... et ainsi être ouvert en permanence (même en lecture seule, en cas de réseau ou pour en conserver l'accès 'administrateur').

virginie00035 · 31 Mars 2011

Re : Macro pour modifier une ligne dans code VBA

Bonjour Kjin et Bond !
Merci pour vos remarques d'abord parce je sais bien que mon code pouvait être simplifié mais je n'osais pas trop y toucher tant que ça marchait... Mais c'est grâce à vous que j'avance !
Kjin, je teste ta procédure au plus vite et te tiens au courant. Il faudrait effectivement boucler sur l'ensemble des fichiers (de E1.xls à E90.xls en l'occurence), mais si ça marche comme ça, ce sera très bien.
Merci encore et bonne journée !

Macro pour modifier une ligne dans code VBA

virginie00035

XLDnaute Nouveau

bond

XLDnaute Occasionnel

virginie00035

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

bond

XLDnaute Occasionnel

virginie00035

XLDnaute Nouveau

Discussions similaires

Macro pour modifier une ligne dans code VBA

virginie00035

XLDnaute Nouveau

bond

XLDnaute Occasionnel

virginie00035

XLDnaute Nouveau

kjin

XLDnaute Barbatruc

bond

XLDnaute Occasionnel

virginie00035

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency