Discussion :

[Pompaero]

Bonjour

J'ai un fichier faisant office de main courante pour mon taf, j'arrive à sa finalité mais aurai besoin de votre aide pour faire concorder 2 codes.

Depuis quelques jours je suis dessus à faire des essais et encore des essais, mais n'y arrive pas

Un bouton "écrire votre texte" permet l'ouverture de l'UsF_Editer.
On complète les renseignements "Editeur", "Evénement" et click sur le bouton "Inscription de la donné" puis les infos s'inscrivent à partir de la ligne 22.
Jusque la tout va bien, ça marche.
Mon souhait est des que j'arrive 2 lignes au dessus du mot "consignes" en A30, une ligne se rajoute.
J'ai bien créé la macro "Lancer" dans le module 1 qui effectue ce souhait mais je n'arrive pas à la faire concorder avec le code du bouton "Inscription de la donné".

Le pire c'est quand je selectionne manuellement la cellule Col A, 2 lignes au dessus du mot "consignes" cela fonctionne.
Le mot "consignes" en A30 sert de référence dans la macro "Lancer"

Si quelqu'un peu m'aider sur ce coup, ça serai sympas.

Code du bouton "Inscription"

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
24
25
26
     'PARTIE CORRESPONDANTE AU BOUTON ENREGISTRER L'EVENEMENT
Private Sub CommandButton1_Click()
Dim dLign As Long
 
If ComboBox1 = "" Then
   MsgBox "L'éditeur est manquant !"
Exit Sub
End If
 
'Lancer  '<--### Ajout d'une ligne quand l'écriture arrive 2 lignes au dessus du mot consignes en A30
 
If flagModif Then
    Transfert (nLign) 'Copie la valeur des objets dans les colonnes et lignes correspondante
    EffaceTout        'efface les objets après inscription
Else
    dLign = ActiveSheet.Range("B65000").End(xlUp).Row + 1
    Transfert (dLign) 'Copie la valeur des objets dans les colonnes et lignes correspondante
    EffaceTout        'efface les objets après inscription
End If
 
AutoFitMergedCellRowHeight Range("B" & dLign)
flagModif = False
Label2 = Label2.Caption + 1
Unload Me
Range("J3").Select
End Sub

Puis la macro "Lancer"

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
Sub Lancer()
Dim rng As Range ', LgFin As Integer
    'on recherche le mot "consignes colonne A
    Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
    If ActiveCell.Row = rng.Row - 2 Then
        '=> on insère une ligne
        Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1).Insert shift:=xlDown
        'copié/collé pour la mise en forme
        Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Copy Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1)
    End If
    'Double click à partir de A22 (colonne A) pour afficher l'heure
    'If Not rng Is Nothing Then LgFin = rng.Row - 1
    'If ActiveCell.Column = 1 And ActiveCell.Row >= 22 And ActiveCell.Row <= LgFin Then ActiveCell.Value =Time: Cancel = True
End Sub

Fichier en PJ :
Main Courante électronique V0.xlsm

[parmi]

Bonjour,

(Je n'ouvre pas les fichiers avec macros...)
Dans ta première macro (bouton), tu utilises une variable nLign.
J'imagine qu'elle est définie à quelque part et qu'elle est déclarée au début du module en Public.

Dans ton autre macro, tu utilises Activecell.Row
Je ne sais pas si la cellule active est bien sur la ligne à remplir (?)
Si tu utilisais nLign à la place, est-ce que ça fonctionnerait mieux ?

[Pompaero]

Bonjour parmi

Merci d'être arrêté sur mon post et de vouloir m'aider.

Pas grave pour l'ouverture du fichier, c'est pour ça que j'ai mis les codes aussi.

Je viens de tester ta proposition, cela ne change rien, mais bien vue tout de même.

J'ai l'impression que c'est un problème de cellule active car si je sélectionne la cellule manuellement , 2 lignes au dessus du mot "consignes" et ensuite utilise l'UsF_Editer, le rajout de ligne s'effectue bien.
Je crois que le code du bouton, active la cellule en col B
et le code du module en col A.
mais plus sur !!

J'ai même essayé de modifier le dernier bout de code (dernière ligne) du code module de manière à avoir un Range.select en col A en automatique, j'y suis pas arrivé non plus.
Mon problème est que j'ai tellement essayé de choses que je ne vois plus comment faire, donc une solution serait la bien venue.

Merci
Cdlt

[cerede2000]

Bonjour à toi,

En prenant ActiveCell ça ne risque pas de fonctionner....
Ceci fonctionne comme tu le souhaites :

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
Sub Lancer()
Dim rng As Range ', LgFin As Integer
    'on recherche le mot "consignes colonne A
    Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
    If Not IsEmpty(rng.Offset(-3)) Then
        '=> on insère une ligne
        rng.Offset(-1).EntireRow.Insert
        'Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1).Insert shift:=xlDown
        'copié/collé pour la mise en forme
        'Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Copy Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1)
    End If
    'Double click à partir de A22 (colonne A) pour afficher l'heure
    'If Not rng Is Nothing Then LgFin = rng.Row - 1
    'If ActiveCell.Column = 1 And ActiveCell.Row >= 22 And ActiveCell.Row <= LgFin Then ActiveCell.Value =Time: Cancel = True
End Sub

En passant plutôt qu'un Find pour ça je te conseillerai de mettre une plage nommé, plus rapide à gérer
Et d'utiliser le centrer sur plusieurs colonnes

[Pompaero]

Bonjour cerede2000

Merci de ta contribution.
Je viens de tester ton code, effectivement cela fonctionne. mais ça me dé fusionne les Col B à G.

Désolé,
Par contre il y a un autre souci qui apparais sur un code (toujours dans module 1) qui me permet sur les Col B à G d'ajuster la cellule au texte et rester fusionné.

Nom de la macro : Sub AutoFitMergedCellRowHeight(Plage As Range) 'Ajustement en hauteur des cellules fusionnées
Code de la macro :

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
24
25
26
27
28
Sub AutoFitMergedCellRowHeight(Plage As Range) 'Ajustement en hauteur des cellules fusionnées
Dim PlageSource As Range
Dim PlageCible As Range
Dim Compteur As Long
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
 
   If Plage.MergeCells Then
      With Plage.MergeArea
         .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
         If .Rows.Count = 1 Then ' Dans le nouveau contexte c'est inutile mais je l'ai laissé
            Application.ScreenUpdating = False
            CurrentRowHeight = .RowHeight
            ActiveCellWidth = Plage.Range("B1").ColumnWidth ' Prend en compte la largeur de la cellule la plus à gauche de la plage
            MergedCellRgWidth = Plage.Width ' Prend en compte la largeur totale de la plage
            .MergeCells = False ' Défusionne les cellules pour ajuster le texte
            .Cells(1).ColumnWidth = MergedCellRgWidth ' Affecte la largeur totale de la plage originale à la seule première cellule
            .EntireRow.AutoFit ' Effectue le dimensionnement suivant le contenu
            PossNewRowHeight = .RowHeight
            .Cells(1).ColumnWidth = ActiveCellWidth ' Ramène la largeur de la première cellule à sa valeur originale
            .MergeCells = True ' Refusionne
            .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight) ' Ajuste la hauteur
            Application.ScreenUpdating = True
         End If
      End With
   End If
End Sub

Je sais pas si je vais m'en sortir avec ce fichier , mais j'y crois quand même, grâce à vous.

Merci
Cdlt

[cerede2000]

Je ne sais pas si tu as beaucoup parcourus ce forum et particulièrement la section VBA mais on déconseille énormément les cellules fusionnés.
C'est source de pas mal de problème et de gestion complexe...

Comme je l'ai indiqué dans mon message précédent utilise le centré sur plusieurs colonnes.....

Etant donné que c'est toi qui créé le fichier il est encore temps de faire sans fusion et de simplifier tout ça