Simplifier un code pour effacer un formulaire

Le 23/03/2020 à 14:28

Bonjour à tous,

J'utilise le code ci-dessous pour effacer le contenu d'un document :

Sub Efface()

Union(Range("A2").MergeArea, Range("D2").MergeArea, Range("G2").MergeArea, Range("I2").MergeArea, Range("A5").MergeArea, Range("U9").MergeArea).ClearContents
Range("M15, O15, Q15, S15, U15").ClearContents
Range("M17, O17, Q17, S17, U17").ClearContents
Range("M19, O19, Q19, S19, U19").ClearContents
Range("M21, O21, Q21, S21, U21").ClearContents
Range("M25, O25, Q25, S25, U25").ClearContents
Range("M27, O27, Q27, S27, U27").ClearContents

Range("M32, O32, Q32, S32, U32").ClearContents
Range("M34, O34, Q34, S34, U34").ClearContents
Range("M36, O36, Q36, S36, U36").ClearContents

Range("M41, O41, Q41, S41, U41").ClearContents

Range("M46, O46, Q46, S46, U46").ClearContents
Range("M48, O48, Q48, S48, U48").ClearContents
Range("M50, O50, Q50, S50, U50").ClearContents
Range("M52, O52, Q52, S52, U52").ClearContents
Range("M54, O54, Q54, S54, U54").ClearContents

Range("M59, O59, Q59, S59, U59").ClearContents
Range("M61, O61, Q61, S61, U61").ClearContents
Range("M63, O63, Q63, S63, U63").ClearContents
Range("M65, O65, Q65, S65, U65").ClearContents
Range("M67, O67, Q67, S67, U67").ClearContents
Range("M69, O69, Q69, S69, U69").ClearContents

Range("M74, O74, Q74, S74, U74").ClearContents

Range("M79, O79, Q79, S79, U79").ClearContents
Range("M81, O81, Q81, S81, U81").ClearContents
Range("M83, O83, Q83, S83, U83").ClearContents
Range("M85, O85, Q85, S85, U85").ClearContents
Range("M87, O87, Q87, S87, U87").ClearContents
Range("M89, O89, Q89, S89, U89").ClearContents
Range("M91, O91, Q91, S91, U91").ClearContents
Range("M93, O93, Q93, S93, U93").ClearContents
Range("M95, O95, Q95, S95, U95").ClearContents
Range("M97, O97, Q97, S97, U97").ClearContents
Range("M99, O99, Q99, S99, U99").ClearContents
Range("M101, O101, Q101, S101, U101").ClearContents
Range("M103, O103, Q103, S103, U103").ClearContents
Range("M105, O105, Q105, S105, U105").ClearContents
Range("M107, O107, Q107, S107, U107").ClearContents
Range("E85, K85, K87, E89, K89, E91, K91, K93").ClearContents

Range("M117, O117, Q117, S117, U117").ClearContents
Range("M119, O119, Q119, S119, U119").ClearContents
Range("M121, O121, Q121, S121, U121").ClearContents

Range("M126, O126, Q126, S126, U126").ClearContents
Range("M128, O128, Q128, S128, U128").ClearContents
Range("M130, O130, Q130, S130, U130").ClearContents
Range("M132, O132, Q132, S132, U132").ClearContents
Range("M134, O134, Q134, S134, U134").ClearContents
Range("M136, O136, Q136, S136, U136").ClearContents

Range("M141, O141, Q141, S141, U141").ClearContents
Range("M143, O143, Q143, S143, U143").ClearContents
Range("M145, O145, Q145, S145, U145").ClearContents
Range("M147, O147, Q147, S147, U147").ClearContents
Range("B149, D149, I149, K149").ClearContents
Range("B151, D151, I151, K151").ClearContents

Range("M156, O156, Q156, S156, U156").ClearContents
Range("M158, O158, Q158, S158, U158").ClearContents
Range("M160, O160, Q160, S160, U160").ClearContents
Range("B162, D162, I162, K162").ClearContents

Range("M167, O167, Q167, S167, U167").ClearContents
Range("M169, O169, Q169, S169, U169").ClearContents
Range("M171, O171, Q171, S171, U171").ClearContents
Range("M173, O173, Q173, S173, U173").ClearContents
Range("M175, O175, Q175, S175, U175").ClearContents
Range("G175").MergeArea.ClearContents

Range("M180, O180, Q180, S180, U180").ClearContents
Range("M182, O182, Q182, S182, U182").ClearContents
Range("M184, O184, Q184, S184, U184").ClearContents
Range("M186, O186, Q186, S186, U186").ClearContents
Range("M188, O188, Q188, S188, U188").ClearContents
Range("G186").MergeArea.ClearContents
Range("G188").MergeArea.ClearContents

Range("M193, O193, Q193, S193, U193").ClearContents
Range("M195, O195, Q195, S195, U195").ClearContents

Range("M200, O200, Q200, S200, U200").ClearContents
Range("M202, O202, Q202, S202, U202").ClearContents
Range("M204, O204, Q204, S204, U204").ClearContents
Range("M206, O206, Q206, S206, U206").ClearContents
Range("M208, O208, Q208, S208, U208").ClearContents
Range("M210, O210, Q210, S210, U210").ClearContents
Range("M213, O213, Q213, S213, U213").ClearContents
Range("M215, O215, Q215, S215, U215").ClearContents
Range("M217, O217, Q217, S217, U217").ClearContents

Range("A224").MergeArea.ClearContents
Range("A226").MergeArea.ClearContents
Range("A228").MergeArea.ClearContents
Range("A230").MergeArea.ClearContents
Range("A232").MergeArea.ClearContents
Range("B235").MergeArea.ClearContents
Range("B237").MergeArea.ClearContents

Range("X2, X4").ClearContents

End Sub

Le code fonctionne parfaitement mais il a un gros défaut. En effet, lorsque je dois ajouter une ligne, une cellule ou autre, je dois à chaque fois décaler toutes mes cellules.

Est-ce qu'il n'existerait pas une meilleure façon de procéder? Par exemple, vider toutes les cellules qui ne sont pas verrouillées?

D'avance merci pour votre retour

Le 23/03/2020 à 14:54

Bonjour ludo88, le forum,

Est-ce qu'il n'existerait pas une meilleure façon de procéder? Par exemple, vider toutes les cellules qui ne sont pas verrouillées?

Ce serait effectivement plus simple.....

Un code du genre:

Sub testEfface()
 Dim plage As Range, cel As Range
  Set plage = Sheets("TaFeuille").Range("A1:F100")
   For Each cel In plage
    If Not cel.Locked Then cel.ClearContents
   Next cel
End Sub
12classeur1.xlsm (20.07 Ko)

Cordialement,

Le 23/03/2020 à 15:22

Bonjour,

Merci pour cette réponse hyper rapide

J'ai appliqué cette macro à mon document mais elle ne fonctionne pas. Je crois que l'erreur vient du fait que j'ai quelques cellules fusionnées qui doivent également effacées? Est-ce possible?

Le 23/03/2020 à 15:37

Re,

Peut-être ainsi alors....

Sub testEfface()
 Dim plage As Range, cel As Range
  Set plage = Sheets("TaFeuille").Range("A1:F100")
   For Each cel In plage
     If Not cel.Locked Then cel = ""
   Next cel
End Sub

EDIT:....ce code semble également fonctionner...

Sub testEfface()
 Dim plage As Range, cel As Range, c As Range
  Set plage = Sheets("TaFeuille").Range("A1:F100")
   For Each cel In plage
     If Not cel.MergeArea.Locked Then cel.MergeArea.ClearContents
   Next cel
End Sub

Cordialement,

Le 29/03/2020 à 17:46

Bonjour,

Le code fonctionne parfaitement sur mon document

C'est vraiment plus agréable que l'ancien que j'utilisais

A bientôt sur le forum

Rechercher des sujets similaires à "simplifier code effacer formulaire"