Discussion :

[poytim]

Bonjour,

je bloque depuis un certain temps.

Voici une macro d'origine.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Macro6()
 
Dim Frml As String
Frml = ActiveCell.FormulaArray
 
If ActiveCell.FormulaArray = "" Then GoTo Suite
 
    If InStr(Frml, "& -") Then Frml = Left(Frml, InStrRev(Frml, "&") - 1)
    Frml = Frml & "&"" - " & CommandBars.ActionControl.Text & """"
    ActiveCell.FormulaArray = Frml
 
    Exit Sub
 
Suite:
    Frml = CommandBars.ActionControl.Text
    ActiveCell.FormulaArray = Frml
 
    Exit Sub
 
End Sub

C'est efficace, mais j'aimerais l'améliorer avec une sélection multiple. J'ai plusieurs macro d'action Control que je voudrais optimiser dans ce sens.

Si je sélectionne plusieurs cellules (isolé), j'aimerais qu'il me lance la macro pour toutes les cellules sélectionnés et individuellement bien sûr puisque je ne dois pas perdre mes formules.
Je viens de passer 5 heures dessus en cherchant dans tous les forum et solution, mais c'est un vrai casse tête. Rien ne fonctionne.

J'ai beau essayer avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each cel In Selection

, ça ne marche toujours que pour la première cellule sélectionne (active)

J'ai fait des test en utilisant une partie du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro0()
Dim cel As Range
Dim Frml As String
Frml = ActiveCell.FormulaArray
 
 
For Each cel In Selection
 
    'Frml = CommandBars.ActionControl.Text
    'ActiveCell.FormulaArray = Frml
 
Next
 
End Sub

J'ai essayé de remplacer ActiveCell par Sélection et j'ai de l'édition multiple seulement si je sélectionne des cellules en continue, et non pas individuellement. Peut être que cette possibilité est trop récente pour que ce soit pris en compte par VBA.

En tout cas merci beaucoup de m'avoir lu

[ARTURO83]

Bonjour,

remplacez

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Each cel In Selection 
    Frml = CommandBars.ActionControl.Text
    ActiveCell.FormulaArray = Frml 
Next

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Each cel In Selection 
    Frml = CommandBars.ActionControl.Text
    Cel.FormulaArray = Frml 
Next

Cel à la place de ActiveCell

Cdlt

[poytim]

Bonjour Arturo,

Merci pour ton intérêt et ton support.

Cel me donne le même résultat que Selection.
La première cellule sélectionné va avoir du texte, mais pas les autres.

Bonne journée !

[ARTURO83]

Cel me donne le même résultat que Selection.
La première cellule sélectionné va avoir du texte, mais pas les autres.

Curieux, voici un fichier en exemple ne reprenant que la boucle en question. Sélectionnez plusieurs cellules contiguës ou pas et cliquez sur le bouton. N'est-ce pas ce que vous attendez?
Pièce jointe 429047

Cdlt

[poytim]

Merci Arturo.

Effectivement c'est bizarre, alors j'ai remplacé tous les frml par cel.FormulaArray.
Je n'ai plus de problème depuis même si c'est moins propre.

Ce code marche :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Macro6()
Dim cel As Range
For Each cel In Selection
 
If cel.FormulaArray = "" Then GoTo Suite
 
    If InStr(cel.FormulaArray, "& -") Then cel.FormulaArray = Left(cel.FormulaArray, InStrRev(cel.FormulaArray, "&") - 1)
    cel.FormulaArray = cel.FormulaArray & "&"" - " & CommandBars.ActionControl.Text & """"
    cel.FormulaArray = cel.FormulaArray
Next
    Exit Sub
 
Suite:
For Each cel In Selection
    cel.FormulaArray = CommandBars.ActionControl.Text
    cel.FormulaArray = cel.FormulaArray
Next
 
End Sub

Celui-ci ne marche pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Macro6()
Dim cel As Range
Dim frml as string
frml = cel.FormulaArray
 
 
For Each cel In Selection
 
If cel.FormulaArray = "" Then GoTo Suite
 
    If InStr(frml, "& -") Then frml = Left(frml, InStrRev(frml, "&") - 1)
    frml = frml & "&"" - " & CommandBars.ActionControl.Text & """"
    cel.FormulaArray = frml
Next
    Exit Sub
 
Suite:
For Each cel In Selection
    frml = CommandBars.ActionControl.Text
    cel.FormulaArray = frml
Next
 
End Sub

J'ai pu adapter tous mes autres codes et ça marche du tonnerre.

Merci pour ton support inestimable !

Tim