1 pièce(s) jointe(s)
Coordination entre 2 codes.
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:
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:
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 :
Pièce jointe 205983
