Rendre une macro permanente

bertrand19 · 2 Août 2007

Bonjour,

Je suis entrain de travailler sur un formulaire....
Il y a des questions et des réponses...
Pour certaines réponses, j'ai du créer des cadres en fusionnant les cellules...

Problème, une fois que mes cellules sont fusionnées, la combinaison de fonction "renvoit à la ligne" et "ajuster" ne marche plus...
Et donc mon cadre ne s'adapte plus à la taille de ma réponse...

Après quelques heures de recherche, j'ai appris que l'unique solution était de créer une macro... j'ai réussit à en trouver le code sur le forum

le code est le suivant:

Attribute VB_Name = "AjusterHauteurLignesMergedCells"

'ajuster automatiquement la hauteur de ligne de cellules fusionnées
'la macro est conçue pour agir sur des cellules fusionnées sur la
'même ligne (ou à l'aide du bouton "centrer sur plusieurs colonnes")

Sub AutoFitMergedCellRowHeight()
'Jim Rech, mpep

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If

End Sub

Mon problème est qu'il faut activer la macro pour qu'elle ajuste la taille des cadres.
N'y a t il pas un moyen de rendre ces cadres ajustables automatiques sans que les destinataires est besoin de faire executer la macro?????

bertrand19 · 2 Août 2007

Re : Rendre une macro permanente

Pardon, mais je suis tellement saouler par ce casse tête que j'en oublie tout sens civisme....

Merci par avance pour vos réponses!

et solidarité avec ceux qui sont comme moi, pas encore en vacances

Compte Supprimé 979 · 2 Août 2007

Re : Rendre une macro permanente

Salut Bertrand19,

Tu peux mettre le code dans la feuille de ton formulaire, en modifiant le nom de la sub

Code:

[COLOR=green][B]Private Sub Worksheet_Change(ByVal Target As Range)
[/B][/COLOR]Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
  With ActiveCell.MergeArea
    .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
    If .Rows.Count = 1 Then 'And .WrapText = True Then
      Application.ScreenUpdating = False
      CurrentRowHeight = .RowHeight
      ActiveCellWidth = ActiveCell.ColumnWidth
      For Each CurrCell In Selection
        MergedCellRgWidth = CurrCell.ColumnWidth + _
        MergedCellRgWidth
      Next
      .MergeCells = False
      .Cells(1).ColumnWidth = MergedCellRgWidth
      .EntireRow.AutoFit
      PossNewRowHeight = .RowHeight
      .Cells(1).ColumnWidth = ActiveCellWidth
      .MergeCells = True
      .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
      CurrentRowHeight, PossNewRowHeight)
    End If
  End With
End If
[COLOR=green][B]End Sub[/B][/COLOR]

Comme ça, à chaque changement dans une cellule, la macro va vérifier si il s'agit d'une cellule fusionnée.

Voilà 😉

bertrand19 · 2 Août 2007

Re : Rendre une macro permanente

Merci Bruno pour ta réponse

Hélas, il doit y avoir une ou deux petites choses qui m'échappent encore!!!

D'habitude quand je recopie une macro, je vais dans VBA, j'ouvre la page du module ou bien de double clic sur une des feuilles du classeur dans VBA.
La macro est créée et je l'execute....

Avec ta formule, je la recopie mais aucun nom est associé à la macro... C'est comme si elle n'existait pas...

En fait, j'ai deux doutes???
- Faut il que je colle la macro dans "feuill 1" ou bien dans "Module" dans VBA??
- Comment je fais pour donner un nom à la macro (sans bloqué son
automatisme)???

Merci pour ton aide...

Bertrand 19

Compte Supprimé 979 · 2 Août 2007

Re : Rendre une macro permanente

re,

Il faut que tu ouvres l'éditeur VBA,
Ensuite tu vas dans le code de ta feuille qui contient le formulaire
Tu colles le code que je t'ai donné.

Pas besoin de nom pour la macro, puisqu'il s'agit d'une macro "évènement"
Private Sub Worksheet_Change(ByVal Target As Range)

A chaque changement dans ton worksheet (ta feuille), la macro est exécutée !

Suis-je assez clair ?
A+

bertrand19 · 2 Août 2007

Re : Rendre une macro permanente

Re,

Ton message est clair, pas de problème!!!
J'ai bien compris qu'a chaque modification de la feuille, la macro s'execute... Et c'est exactement ce que je voulais...

Néanmoins, je viens d'essayer cette manip et il ne se passe rien quand j'écris dans mes cellules fusionnées entre elles.

Je vais essayer de te décrire ce que j'ai fait....

j'ouvre mon classeur,
je vais dans VBA
je fais afficher les feuilles qui se trouvent dans "Microsoft excel objects"
je double clic sur ma feuille 1
à droite s'ouvre une page blanche dans laquelle je copie ton code
je sauvegarde, je ferme

j'ouvre de nouveau mon fichier, je tape une phrase dans mon cadre... Mais pas d'ajustement!!!
- Faut il que je garde "ajuster" et "renvoi automatique" cocher ou pas???
- J'ai pas de module sous les 'microsoft excel objects", est ce génant???

Merci

Compte Supprimé 979 · 2 Août 2007

Re : Rendre une macro permanente

Bertrand,

Je n'avais pas testé le code, que tu avais donné au départ 😱

En fait il faut remplacer les 3 "ActiveCell.", par "Target."
Et là, ça fonctionne 😉

bertrand19 · 3 Août 2007

Re : Rendre une macro permanente

Bruno, merci pour ton coup de main!

Effectivement, l'ajustement n'est pas parfait mais j'ai demandé à un ami de m'aider et ta macro lui a été bien utile!
il faut l'adapter à chaque page mais c'est déjà un bon début.
Pour mon problème, c'est suffisant!

Je te la mets en copie ci-dessous

Bon continuation et un GROS merci!

Pour les personnes qui arriveraient sur cette page, et qui cherche plus d'explications sur la macro suivante afin de l'adapter à leur situation, allez sur le lien suivant!

Bon courage

https://www.excel-downloads.com/thr...e-du-texte-dans-des-cellules-fusionner.79652/

La macro

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

' Test la cellule ou à été fait la modif

If Target.MergeCells Then

With Target.MergeArea

.WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)

If .Rows.Count = 1 Then

Application.ScreenUpdating = False

If Round(Len(Target.Value) / 35, 0) < 1 Then

.RowHeight = 15 'Hauteur de ligne standard

Else

.RowHeight = 15 * (Round(Len(Target.Value) / 35, 0)) 'Modifier le dénominateur pour régler le nb de caractères par ligne

End If

End If

End With

End If

End Sub

'PARAMETRES

'hauteur de ligne standard = 15

'nb de caractères approximatifs par ligne = 35

'taille de la police = 10

Rendre une macro permanente

bertrand19

Guest

bertrand19

Guest

Compte Supprimé 979

Guest

bertrand19

Guest

Compte Supprimé 979

Guest

bertrand19

Guest

Compte Supprimé 979

Guest

Pièces jointes

bertrand19

Guest

Discussions similaires

Rendre une macro permanente

bertrand19

Guest

bertrand19

Guest

Compte Supprimé 979

Guest

bertrand19

Guest

Compte Supprimé 979

Guest

bertrand19

Guest

Compte Supprimé 979

Guest

Pièces jointes

bertrand19

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency