VBA et Strikethrough

[superbog]

Bonsoir,

Je m'explique.
J'ai un classeur avec de nombreuses feuilles identiques que je remplis par diverses macros (toutes issues du même modèle).

à la fin de la macro, je barre les cellules traitées de sorte que la fois suivante elles ne soient pas traitées en double

j'ai du faire une erreur dans le code car quand je lance la macro, cela barre non seulement les cellules traitées mais aussi les suivantes, vides.

pourriez vous m'aider à résoudre ce petit problème

ci joint fichier exemple
HR est la feuille source (ou les lignes doivent être barrées), 2097 la feuille qui est remplie par la macro

voici la macro en question

Sub HR()

Dim I, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean

'Recherche de la dernière ligne
DerLigBase = Sheets("HR").Range("A9000").End(xlUp).Row
Set colFeuille = New Collection

On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("HR").Range(Cells(2, 1), Cells(DerLigBase, 1))
    colFeuille.Add rCelA, CStr(rCelA)
Next rCelA

'Recherche de la ligne et tri dans chaque feuille
For I = 2 To DerLigBase
    dossier = Cells(I, 1).Text
    Lig = Sheets(dossier).Range("AD9000").End(xlUp).Row
     
     
     'Copie les valeurs si non barrées
With Sheets("HR").Cells(I, "B").Resize(, 7)
  If Not .Cells(1).Font.Strikethrough Then '1ère valeur non barrée
    Worksheets(dossier).Cells(Lig + 1, "AD").Resize(, 7) = .Value
    .Font.Strikethrough = True
  End If
End With


Next I

MsgBox "opération effectuée"

End Sub

 

[superbog]

Re : VBA et Strikethrough

j'ai tout essayé mais mes connaissances en VBA sont insuffisantes pour régler ce problème, et je n'ai rien trouvé en cherchant sur le forum

 

[job75]

Re : VBA et Strikethrough

Bonjour superbog,

Le problème avec vos fils c'est que souvent ils entrainent des questions à rallonge.

Exemple ici : le lancement de la macro ne copie rien, même si l'on "débarre" les lignes en feuille HR 😕

Ne vous étonnez donc pas de ne recevoir aucune réponse.

A+

 

[superbog]

Re : VBA et Strikethrough

chez moi ca marche, peut etre n'avez vous pas vu que c'était les colonnes AD à AI qui étaient concernées dans la feuille 2097

j'ai revérifié le fichier, le voici

 

[job75]

Re : VBA et Strikethrough

Re,

peut etre n'avez vous pas vu que c'était les colonnes AD à AI qui étaient concernées dans la feuille 2097

Ah oui, il suffisait de lire la macro, mais 2 mots d'explications n'étaient pas inutiles 😡

Alors avant de barrer, il suffit de vérifier que la copie a bien eu lieu :

Err = 0 'pour savoir si une erreur se produit
Worksheets(dossier).Cells(Lig + 1, "AD").Resize(, 7) = .Value
If Err = 0 Then .Font.Strikethrough = True

Bien sûr pas de copie si la feuille dossier n'existe pas...

Fichier joint.

A+

 

[superbog]

Re : VBA et Strikethrough

cela fonctionne pour les feuilles qui n'existent pas par contre, le problème originel subsiste, à savoir que les lignes vides du dessous sont barrées d'office. Résultat si après exécution de la macro on tente d'ajouter une ligne, elle est barrée...

 

[job75]

Re : VBA et Strikethrough

Re,

Voyez le fichier (1 bis) où la macro HR() a été exécutée :

- sélectionnez B8 (vide) puis onglet Accueil => Format => Format de cellule => Police : Barré n'est pas coché

- entrez un texte en B8 => même chose => Barré est coché.

Vous découvrez-là une propriété intrinsèque des tableaux sur Excel 2010 : le format de la cellule précédente se recopie automatiquement.

C'est comme ça...

Sans vouloir critiquer ce que vous faites, à mon avis "barrer" n'est pas une bonne solution.

Il vaut beaucoup mieux utiliser une colonne où l'on met un "X" quand la copie est réalisée.

A+

 

[superbog]

Re : VBA et Strikethrough

et pour résoudre ce problème, ne peux t'on prévoir en fin de macro une instruction pour que de la première ligne vide à la dernière, les caractères ne soient pas barrés?

 

[job75]

Re : VBA et Strikethrough

Re,

Je vois que vous n'avez pas du tout compris ce que j'ai dit au post #7.

Après exécution de la macro, de la première ligne vide à la dernière, les polices ne sont pas barrées.

Vérifiez comme je l'ai dit 🙄

A+

 

[superbog]

Re : VBA et Strikethrough

ok donc seule solution la colonne avec x
si l'on prend la colonne de droite pour faire ça, accepteriez vous de me faire la modif de la macro car je viens d'essayer et je me mélange le vba 🙁

 

[job75]

Re : VBA et Strikethrough

Re,

Ok, question à rallonge, mais je vais voir avec une colonne de "X" 🙂

Mais avant, pour compléter ceci :

Vous découvrez-là une propriété intrinsèque des tableaux sur Excel 2010 : le format de la cellule précédente se recopie automatiquement.

Il s'agit d'une option, mais qui s'applique à tous les fichiers Excel.

Voir fichier (2).

A+

 

[superbog]

Re : VBA et Strikethrough

merci car j'ai essayé, même en décochant l'option le problème reste le même 🙁

 

[job75]

Re : VBA et Strikethrough

Re,

Chez moi, en décochant l'option, plus de problème (vous avez cliqué sur OK ?).

Maintenant voici votre fichier (3) et la macro adaptés pour les "X".

Il vaut mieux ajouter une colonne A supplémentaire.

A+

 

[superbog]

Re : VBA et Strikethrough

ok merci (oui j'avais cliqué sur ok)
c'est très gentil à vous

 

[superbog]

Re : VBA et Strikethrough

j'ai tenté d'adapter la macro, mais toutes les cellules sont copiées chaque fois, visiblement la condition X n'est pas prise en compte et le X n'est pas mis dans la colonne une fois la ligne traitée

pourriez vous m'aider?

Sub EPnew()

Dim I, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Wbk1 As Workbook

Workbooks.Open Filename:="C:\Users\brigitte\Dropbox\PARIS EP\EP.xls"

Set Wbk1 = Workbooks("EP.xls")
Set Sh1 = ThisWorkbook.Sheets("EP")
Set Sh2 = Workbooks("EP.xls").Sheets("EP")

'Recherche de la dernière ligne
DerLigBase = Sh2.Range("B9000").End(xlUp).Row
Set colFeuille = New Collection

On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sh2.Range("B2:B" & DerLigBase)
    colFeuille.Add rCelA, CStr(rCelA)
Next rCelA

Sh1.Activate

'Recherche de la ligne et tri dans la feuille fille
    For I = 2 To DerLigBase
    Lig = Sh1.Range("B9000").End(xlUp).Row
     
     
     Sh2.Activate
     
     'Copie les valeurs si non cochées
With Sh2.Cells(I, "B").Resize(, 7)
  If IsEmpty(.Cells(-1)) Then 'colonne A vide
    Err = 0 'pour savoir si une erreur se produit
    
    Sh1.Activate
    
    Sh1.Cells(Lig + 1, "B").Resize(, 7) = .Value
    
    Sh2.Activate
    If Err = 0 Then .Cells(-1) = "X"
  End If
End With

Next I

Wbk1.Close

MsgBox "opération effectuée"


End Sub