Fusion de cellules VBA
Résolu
Amo78
Messages postés
4
Statut
Membre
-
Amo78 Messages postés 4 Statut Membre -
Amo78 Messages postés 4 Statut Membre -
Bonjour,
Pour un projet, j'ai besoin de fusionner plusieurs cellule. Je m’explique : l'utilisateur d'un fichier doit fusionner les même ligne de plusieurs colonnes différentes. Ex si il fusionne B11 à B21 il fusionnera toujours D11 à D21 et F11 à F21, etc...
J'aimerais faire un boîte de dialogue pour lui demandé de saisir sa première ligne et sa dernière afin de fusionner les autres.
Avez vous une idée pour faire ça? J'ai essayé plusieurs fonction en vain...
Merci :)
Pour un projet, j'ai besoin de fusionner plusieurs cellule. Je m’explique : l'utilisateur d'un fichier doit fusionner les même ligne de plusieurs colonnes différentes. Ex si il fusionne B11 à B21 il fusionnera toujours D11 à D21 et F11 à F21, etc...
J'aimerais faire un boîte de dialogue pour lui demandé de saisir sa première ligne et sa dernière afin de fusionner les autres.
Avez vous une idée pour faire ça? J'ai essayé plusieurs fonction en vain...
Merci :)
A voir également:
- Vba fusionner cellules
- Fusionner deux cellules excel - Guide
- Comment fusionner des pdf sans logiciel - Guide
- Pourquoi je ne peux pas fusionner des cellules dans excel - Forum Bureautique
- Impossible de fusionner cellule excel ✓ - Forum Excel
- Fusion de cellules tableau formaté, impossible, bouton grisé - Forum Excel
1 réponse
Bonjour,
en vba se mettre sur la feuille concernée, faire AltF11 et mettre se code qui se déclenchera au double clic sur une cellule:
a adapter naturellement
en vba se mettre sur la feuille concernée, faire AltF11 et mettre se code qui se déclenchera au double clic sur une cellule:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ref As Range
Set ref = Application.InputBox(prompt:="Sélectionner les cellules à fusionner sur la feuille", Type:=8)
Range(ref.Address).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End Sub
a adapter naturellement
j'ai coler le code mais il ne se déclanche pas au doucle clic, y a t-il une manip a effectuer?
https://silkyroad.developpez.com/VBA/EvenementsFeuille/
Option Explicit Dim chaine As String Dim col As String Dim colonne As String Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) On Error Resume Next Dim ref As Range Set ref = Application.InputBox(prompt:="Sélectionner les cellules à fusionner sur la feuille", Type:=8) Range(ref.Address).Select Selection.Merge 'B2:B6 chaine = ref.Address extractionMots chaine = Replace(chaine, col, colonne) 'remplacer colonne B par E Range(chaine).Select Selection.Merge 'E2:E6 End Sub 'Extraire les données séparées par un "$" dans une chaine de caractères Sub extractionMots() Dim Tableau() As String Dim i As Integer 'découpe la chaine en fonction des "$" 'le résultat de la fonction Split est stocké dans un tableau Tableau = Split(chaine, "$") 'boucle sur le tableau pour visualiser le résultat For i = 0 To UBound(Tableau) 'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros Debug.Print Tableau(i) Next i col = Tableau(1) 'colonne en lettre colonne = AlphaColToNum(col) 'colonne en chiffre colonne = Split(Columns(colonne + 3).Address(ColumnAbsolute:=False), ":")(1) 'colonne en lettre + 3 a adapter End Sub 'colonne en chiffre Function AlphaColToNum(col As String) As Long AlphaColToNum = Range(col & 1).Column End FunctionIl y a de nombreux commentaires, tu pourras l'adapter a d'autres configurations!
@+ Le Pivert
Je l'ai adapter sur toutes les colonnes à fusionner, ça marche parfaitement!