OVH Cloud OVH Cloud

Cellule en bouton macro

12 réponses
Avatar
Billout
Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.

10 réponses

1 2
Avatar
Billout
J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.



Avatar
Mousnynao
Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.





Avatar
Billout
Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.







Avatar
Mousnynao
re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.









Avatar
Billout
Ok merci ca marche
As tu ouvert le lien vers le classeur?
J'aimerai copier la ligne 110 et l'inserrer entre la ligne 109 et 110 et
ainsi de suite et donc la ligne 110 deviendrait la ligne 111 , etc..

Merci


re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.











Avatar
Mousnynao
re:

voici ce que ça me donne !

Option Explicit
'

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Flag As Boolean

If Target.Row = 5 Then
If Target.Column = 3 Or Target.Column = 10 Then
Application.EnableEvents = False
Flag = FormatColoneNArticle
If Not (Flag) Then
MsgBox "Erreur dans la mise en forme du texte"
End If
Application.EnableEvents = True
End If
End If

End Sub
'

Private Function FormatColoneNArticle() As Boolean
'
FormatColoneNArticle = False
If Range("C5") <> "" Then
Range("C5").NumberFormat = [A8] & """_0""0000"
Range("J5").NumberFormat = [H8] & """_9""0000"
End If
FormatColoneNArticle = True

End Function
'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Plage As String
Dim Flag As Boolean
Dim Intersection As Range

Application.EnableEvents = False
Plage = Sheets("liste").Range("C65").Value
Set Intersection = Application.Intersect(Target, Range(Plage))

'Est-ce la bonne cellule sélectionné
If Not (Intersection Is Nothing) Then
'MsgBox "La cellule cible est dans l'intersection."
Flag = CopieLigne
If Not (Flag) Then
MsgBox "Erreur dans la copie"
End If
End If
Application.EnableEvents = True

End Sub
'

Private Function CopieLigne() As Boolean

'
Dim Plage, Ligne As String

CopieLigne = False
Plage = Sheets("liste").Range("C65").Value
Ligne = Mid(Plage, 4)

Rows(Ligne & ":" & Ligne).Select
Selection.Copy
Range("A" & (Ligne + 1)).Select
Selection.Insert Shift:=xlDown
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)
Application.CutCopyMode = False
CopieLigne = True

End Function
'

mousnynao


Ok merci ca marche
As tu ouvert le lien vers le classeur?
J'aimerai copier la ligne 110 et l'inserrer entre la ligne 109 et 110 et
ainsi de suite et donc la ligne 110 deviendrait la ligne 111 , etc..

Merci


re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.













Avatar
Billout
Ca ne marche pas
J'ai inséré le code dans la feuille 100 et il me met une erreur 1004 sur la
ligne
Set Intersection = Application.Intersect(Target, Range(Plage))

Merci pour ta patience



re:

voici ce que ça me donne !

Option Explicit
'

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Flag As Boolean

If Target.Row = 5 Then
If Target.Column = 3 Or Target.Column = 10 Then
Application.EnableEvents = False
Flag = FormatColoneNArticle
If Not (Flag) Then
MsgBox "Erreur dans la mise en forme du texte"
End If
Application.EnableEvents = True
End If
End If

End Sub
'

Private Function FormatColoneNArticle() As Boolean
'
FormatColoneNArticle = False
If Range("C5") <> "" Then
Range("C5").NumberFormat = [A8] & """_0""0000"
Range("J5").NumberFormat = [H8] & """_9""0000"
End If
FormatColoneNArticle = True

End Function
'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Plage As String
Dim Flag As Boolean
Dim Intersection As Range

Application.EnableEvents = False
Plage = Sheets("liste").Range("C65").Value
Set Intersection = Application.Intersect(Target, Range(Plage))

'Est-ce la bonne cellule sélectionné
If Not (Intersection Is Nothing) Then
'MsgBox "La cellule cible est dans l'intersection."
Flag = CopieLigne
If Not (Flag) Then
MsgBox "Erreur dans la copie"
End If
End If
Application.EnableEvents = True

End Sub
'

Private Function CopieLigne() As Boolean

'
Dim Plage, Ligne As String

CopieLigne = False
Plage = Sheets("liste").Range("C65").Value
Ligne = Mid(Plage, 4)

Rows(Ligne & ":" & Ligne).Select
Selection.Copy
Range("A" & (Ligne + 1)).Select
Selection.Insert Shift:=xlDown
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)
Application.CutCopyMode = False
CopieLigne = True

End Function
'

mousnynao


Ok merci ca marche
As tu ouvert le lien vers le classeur?
J'aimerai copier la ligne 110 et l'inserrer entre la ligne 109 et 110 et
ainsi de suite et donc la ligne 110 deviendrait la ligne 111 , etc..

Merci


re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.















Avatar
Mousnynao
re:

j'aurais du te spécifier que tu dois pour la première fois insérer l'adresse
de la cellule cible sur la feuille "liste" à l'adresse "C65"

La valeur doit être = $B$110 (La valeur de la cellule C65)

Elle est récupéré par cette ligne !
Plage = Sheets("liste").Range("C65").Value
et mise à jour avec cette ligne :
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)

avec cela ça devrait rouler.

mousnynao



Ca ne marche pas
J'ai inséré le code dans la feuille 100 et il me met une erreur 1004 sur la
ligne
Set Intersection = Application.Intersect(Target, Range(Plage))

Merci pour ta patience



re:

voici ce que ça me donne !

Option Explicit
'

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Flag As Boolean

If Target.Row = 5 Then
If Target.Column = 3 Or Target.Column = 10 Then
Application.EnableEvents = False
Flag = FormatColoneNArticle
If Not (Flag) Then
MsgBox "Erreur dans la mise en forme du texte"
End If
Application.EnableEvents = True
End If
End If

End Sub
'

Private Function FormatColoneNArticle() As Boolean
'
FormatColoneNArticle = False
If Range("C5") <> "" Then
Range("C5").NumberFormat = [A8] & """_0""0000"
Range("J5").NumberFormat = [H8] & """_9""0000"
End If
FormatColoneNArticle = True

End Function
'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Plage As String
Dim Flag As Boolean
Dim Intersection As Range

Application.EnableEvents = False
Plage = Sheets("liste").Range("C65").Value
Set Intersection = Application.Intersect(Target, Range(Plage))

'Est-ce la bonne cellule sélectionné
If Not (Intersection Is Nothing) Then
'MsgBox "La cellule cible est dans l'intersection."
Flag = CopieLigne
If Not (Flag) Then
MsgBox "Erreur dans la copie"
End If
End If
Application.EnableEvents = True

End Sub
'

Private Function CopieLigne() As Boolean

'
Dim Plage, Ligne As String

CopieLigne = False
Plage = Sheets("liste").Range("C65").Value
Ligne = Mid(Plage, 4)

Rows(Ligne & ":" & Ligne).Select
Selection.Copy
Range("A" & (Ligne + 1)).Select
Selection.Insert Shift:=xlDown
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)
Application.CutCopyMode = False
CopieLigne = True

End Function
'

mousnynao


Ok merci ca marche
As tu ouvert le lien vers le classeur?
J'aimerai copier la ligne 110 et l'inserrer entre la ligne 109 et 110 et
ainsi de suite et donc la ligne 110 deviendrait la ligne 111 , etc..

Merci


re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.

















Avatar
Billout
C'est super, je te remercie.
une derniere question, si je copie la feuille 100 pour une feuille 200 ou
300 etc.., il faut que je copie le code et que je change l'adresse "C5" de la
feuille "liste" ou il y t'il une solution pour que ca marche sans changer le
code, du genre, une feuille vierge pour la copie de nvelle feuille.
Encore merci


re:

j'aurais du te spécifier que tu dois pour la première fois insérer l'adresse
de la cellule cible sur la feuille "liste" à l'adresse "C65"

La valeur doit être = $B$110 (La valeur de la cellule C65)

Elle est récupéré par cette ligne !
Plage = Sheets("liste").Range("C65").Value
et mise à jour avec cette ligne :
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)

avec cela ça devrait rouler.

mousnynao



Ca ne marche pas
J'ai inséré le code dans la feuille 100 et il me met une erreur 1004 sur la
ligne
Set Intersection = Application.Intersect(Target, Range(Plage))

Merci pour ta patience



re:

voici ce que ça me donne !

Option Explicit
'

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Flag As Boolean

If Target.Row = 5 Then
If Target.Column = 3 Or Target.Column = 10 Then
Application.EnableEvents = False
Flag = FormatColoneNArticle
If Not (Flag) Then
MsgBox "Erreur dans la mise en forme du texte"
End If
Application.EnableEvents = True
End If
End If

End Sub
'

Private Function FormatColoneNArticle() As Boolean
'
FormatColoneNArticle = False
If Range("C5") <> "" Then
Range("C5").NumberFormat = [A8] & """_0""0000"
Range("J5").NumberFormat = [H8] & """_9""0000"
End If
FormatColoneNArticle = True

End Function
'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Plage As String
Dim Flag As Boolean
Dim Intersection As Range

Application.EnableEvents = False
Plage = Sheets("liste").Range("C65").Value
Set Intersection = Application.Intersect(Target, Range(Plage))

'Est-ce la bonne cellule sélectionné
If Not (Intersection Is Nothing) Then
'MsgBox "La cellule cible est dans l'intersection."
Flag = CopieLigne
If Not (Flag) Then
MsgBox "Erreur dans la copie"
End If
End If
Application.EnableEvents = True

End Sub
'

Private Function CopieLigne() As Boolean

'
Dim Plage, Ligne As String

CopieLigne = False
Plage = Sheets("liste").Range("C65").Value
Ligne = Mid(Plage, 4)

Rows(Ligne & ":" & Ligne).Select
Selection.Copy
Range("A" & (Ligne + 1)).Select
Selection.Insert Shift:=xlDown
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)
Application.CutCopyMode = False
CopieLigne = True

End Function
'

mousnynao


Ok merci ca marche
As tu ouvert le lien vers le classeur?
J'aimerai copier la ligne 110 et l'inserrer entre la ligne 109 et 110 et
ainsi de suite et donc la ligne 110 deviendrait la ligne 111 , etc..

Merci


re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.



















Avatar
Mousnynao
re:

non, je crois que tu ne peux réécrire en plage C65 puisque celle-ci est codé
pour la feuille 100.

suggestion :
indexé cette cellule en fonction de la feuille !

quelques modifs dans la routine :
Private Function CopieLigne() As Boolean

'
Dim Plage, Ligne As String
Dim NomFeuille As String
Dim Indice As Long

NomFeuille = ActiveSheet.Name
Indice = ((Val(NomFeuille) / 100) - 1)
CopieLigne = False
Plage = Sheets("liste").Range("C65").Offset(0, Indice).Value
Ligne = Mid(Plage, 4)

Rows(Ligne & ":" & Ligne).Select
Selection.Copy
Range("A" & (Ligne + 1)).Select
Selection.Insert Shift:=xlDown
Sheets("liste").Range("C65").Offset(0, Indice).Value = Mid(Plage, 1, 3)
& (Ligne + 1)
Application.CutCopyMode = False
CopieLigne = True

End Function
'

et au moment de la copie tu doit définir le nom de la feuille ainsi que sa
cellule
attribué :

Sub CopieFeuille()

Dim Indice As Long

Sheets("100").Select
Sheets("100").Copy After:=Sheets("100")
Sheets("100 (2)").Name = "200"
Indice = ((Val(ActiveSheet.Name) / 100) - 1)
Sheets("liste").Range("C65").Offset(0, Indice).Value =
Sheets("liste").Range("C65").Value

End Sub

n.b. Calculer l'offset avec la valeur du nom de la feuille
Indice = ((Val(ActiveSheet.Name) / 100) - 1)

Dans la méthode [Offset] Offset(0,0) est la cellule active, d'où le [-1].

Range("A1").Offset(0,0).Value ~ Cells(1,1).Value

Ceci répond-il a tes attentes ?

mousnynao


C'est super, je te remercie.
une derniere question, si je copie la feuille 100 pour une feuille 200 ou
300 etc.., il faut que je copie le code et que je change l'adresse "C5" de la
feuille "liste" ou il y t'il une solution pour que ca marche sans changer le
code, du genre, une feuille vierge pour la copie de nvelle feuille.
Encore merci


re:

j'aurais du te spécifier que tu dois pour la première fois insérer l'adresse
de la cellule cible sur la feuille "liste" à l'adresse "C65"

La valeur doit être = $B$110 (La valeur de la cellule C65)

Elle est récupéré par cette ligne !
Plage = Sheets("liste").Range("C65").Value
et mise à jour avec cette ligne :
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)

avec cela ça devrait rouler.

mousnynao



Ca ne marche pas
J'ai inséré le code dans la feuille 100 et il me met une erreur 1004 sur la
ligne
Set Intersection = Application.Intersect(Target, Range(Plage))

Merci pour ta patience



re:

voici ce que ça me donne !

Option Explicit
'

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Flag As Boolean

If Target.Row = 5 Then
If Target.Column = 3 Or Target.Column = 10 Then
Application.EnableEvents = False
Flag = FormatColoneNArticle
If Not (Flag) Then
MsgBox "Erreur dans la mise en forme du texte"
End If
Application.EnableEvents = True
End If
End If

End Sub
'

Private Function FormatColoneNArticle() As Boolean
'
FormatColoneNArticle = False
If Range("C5") <> "" Then
Range("C5").NumberFormat = [A8] & """_0""0000"
Range("J5").NumberFormat = [H8] & """_9""0000"
End If
FormatColoneNArticle = True

End Function
'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Plage As String
Dim Flag As Boolean
Dim Intersection As Range

Application.EnableEvents = False
Plage = Sheets("liste").Range("C65").Value
Set Intersection = Application.Intersect(Target, Range(Plage))

'Est-ce la bonne cellule sélectionné
If Not (Intersection Is Nothing) Then
'MsgBox "La cellule cible est dans l'intersection."
Flag = CopieLigne
If Not (Flag) Then
MsgBox "Erreur dans la copie"
End If
End If
Application.EnableEvents = True

End Sub
'

Private Function CopieLigne() As Boolean

'
Dim Plage, Ligne As String

CopieLigne = False
Plage = Sheets("liste").Range("C65").Value
Ligne = Mid(Plage, 4)

Rows(Ligne & ":" & Ligne).Select
Selection.Copy
Range("A" & (Ligne + 1)).Select
Selection.Insert Shift:=xlDown
Sheets("liste").Range("C65").Value = Mid(Plage, 1, 3) & (Ligne + 1)
Application.CutCopyMode = False
CopieLigne = True

End Function
'

mousnynao


Ok merci ca marche
As tu ouvert le lien vers le classeur?
J'aimerai copier la ligne 110 et l'inserrer entre la ligne 109 et 110 et
ainsi de suite et donc la ligne 110 deviendrait la ligne 111 , etc..

Merci


re:

Ce code doit être placé derrière une feuille et non dans un module standard.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Lorsque la sélection est changé, Target prend la valeur
' de la position de la cellule sélectionnée, on y applique
' un test d'intersection avec la cellule simili "bouton"
Set InTerSection = Application.Intersect(Target, Range("B110"))

'Est-ce la bonne cellule sélectionné
If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
' Ici le code du simili bouton [cellule B110]
DoEvents
End If

End Sub

Est-ce plus clair ainsi !

mousnynao


Bonjour,
j'ai essayé de copier le code dans la feuille, mais ca ne marche pas. En VBA
je suis nul, je suis juste bon a créer des macro avec l'éditeur de macro
excel.
Su tu pouvez m'expliquer un peu ton code ca m'arrangeré.
Merci



Slt,

Pour commencer je te propose ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim AdresseIntersection As String

'Je ne me souviens plus de la position [B110]!
'AdresseIntersection = Sheets("Maitre").Range("C12").Value

Set InTerSection = Application.Intersect(Target, Range("B111"))
'Set InTerSection = Application.Intersect(Target,
Range(AdresseIntersection))

If Not (InTerSection Is Nothing) Then
MsgBox "La cellule cible est dans l'intersection."
'instruction ...
DoEvents
End If

End Sub

mousnynao!


J'ai oublier de stipuler que la ligne 111 deviendra 112 et ainsi de suite
lors de la copie/insertion et la ligne a copier 111 puis 112 etc...


Bonjour,
Je cherche un moyen pour que ma ligne 111 " cellules fusionnées" deviennent
un bouton. Ce bouton doit copier la ligne 110 et inserer la copie entre la
ligne 110 et 111.
La copie doit comporter les formules, les formats et les validations ainsi
que les protection et masquage des formules.
Je suis limité en VBA, si quelqu'un peut m'aider ca serait sympas.
Voir le lien pour ouvrir le classeur.
C'est une basse de données qui sera rempli par des personnes qui ne
connaisent pas excel.
De plus je ne veux pas incrementer de suite 15000 lignes avec formules et
tous le tintouin car ca grossi le classeur, sur ce projet il n'y a que 2
feuilles mais par la suite on pourra incrementer des feuilles pour les
differentes codifications.


http://cjoint.com/?bjqzRwiEmL

Merci à tous.





















1 2