Menu

Duplication de la ligne avec incrementation [Résolu]

devimen - 11 avril 2018 à 15:30 - Dernière réponse :  devimen
- 16 avril 2018 à 09:24
Bonjour ,

Je suis débutante en VBA et j'ai besoin de votre aide pour modifier ma macro s'il vous plait [​IMG]

mon probléme :
Ma macro fonctionne avec un Menu contextuel [​IMG] .Donc je voudrais quand utilisateur fini a remplir toute une ligne, après quand il clique sur le souris ou s'est nommé "duplication de la ligne " ; un message Box montre n° de trajet de début ,après un autre message Box ,n°de trajet de fin .
Donc a partir de n° trajet de début jusqu’au numéro de trajet de fin , il incrémente avec un +1 , avec recopie de toute la ligne .

'exemple :) :
N° trajet de debut :580
N) trajet de fin: 584
donc je voudrai avoir
581
582
583
584
avec coipe de tout les données de la ligne de n0 de trajet 581 de debut pour les autres numéros de trajet .
' code VBA
Sub dupliquerlignes()
Dim lignes As Integer
Dim debut As Integer
debut = InputBox("N° DE DEBUT ")
fin=InputBox("N °DE FIN ")
For Debut To Fin
With ActiveCell.EntireRow
.Offset(debut, 0).Insert Shift:=xlDown
.Copy Destination:=.Offset(debut, 0)
debut=debut+1
End With
Next debut
End Sub
' Menu contextuel

Private Sub Workbook_Open()
Call Creer_Menu_Contextuel_2
End Sub

Sub Creer_Menu_Contextuel_2()

'réinitialize la sourie comme à l'origine
Application.CommandBars("Cell").Reset

'Crée une commande dans le menu
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Duplication de la ligne" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "dupliquerlignes" 'appel de la macro

End With

End Sub

Sub reset_menudroit()
CommandBars("Cell").Reset
End Sub

j'espere que j'ai bien expliquer mon probléme .
Dans l'attente de vos répense .Je vous remercie d'avance :)
Afficher la suite 

8 réponses

Répondre au sujet
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 11 avril 2018 à 18:18
+1
Utile
7
Bonjour,

je n'ai pas très bien compris cette ligne:

avec coipe de tout les données de la ligne de n0 de trajet 581 de debut pour les autres numéros de trajet .

voir cela si ça correspond à la demande:

Sub dupliquerlignes()
Dim ligne As Integer
Dim i As Integer
Dim debut As Integer
Dim fin  As Integer
debut = InputBox("N° DE DEBUT ")
fin = InputBox("N °DE FIN ")
ligne = ActiveCell.Row 'ligne cellule active
For i = debut To fin
ActiveCell.Copy Destination:=ActiveCell.Offset(i - ligne, 0)
Next i
End Sub

Bonjour,
Merci pour votre reponse ,j'ai pas bien expliquée mon problémé ; Excusez moi s'il vous plait comme je suis debutante sur le forum :( .
exemple :

N° trajet de debut egale a :la cellule active qui est egale à 581
N° trajet de fin sera saisie par Message Box : 584
donc je voudrai avoir
1) 581 a b c
2) 582 a b c
3) 583 a b c
4) 584 a b c
donc : copier la ligne n°1 et la dupliquer pour ligne 2 ,3,4 mais avec incrementation de +1 pour n° de trajet .

J'espere que j'ai bien expliquée. Dans l'attente de votre reponse s'il vous plait :)
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 12 avril 2018 à 11:06
voilà avec les commentaires pour comprendre et adapter le cas échéant:

Option Explicit
Dim var As String 'valeur cellule active
Dim debut As Integer 'numerique cellule active
Dim ligne As Integer ' ligne cellule active
Dim fin  As Integer 'numerique de fin
Dim result As Integer 'nombre de ligne à ajouter
Sub dupliquerlignes()
fin = InputBox("N °DE FIN ")
var = ActiveCell.Value
extractionMots
ligne = ActiveCell.Row
result = fin - debut 'nombre de ligne à ajouter
ActiveCell.AutoFill Destination:=Range("A" & ligne & ":A" & ligne + result), Type:=xlFillDefault 'adapter colonne
End Sub
'Extraire les données séparées par un espace dans une chaine de caractères
Sub extractionMots()
    Dim Tableau() As String
    Dim i As Integer
    
    'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(var, " ")
    
    '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
    debut = Tableau(0) 'numerique cellule active
End Sub


@+ Le Pivert
Bonjour,

Merci pour votre reponse ,ça fonctionne trés bien .Merci pour votre aide :) .
Suijet résolu :D
cs_Le Pivert 5065 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 13 avril 2018 Dernière intervention - 13 avril 2018 à 17:39
Amélioration dans le code:

Plus besoin de mettre la lettre de la colonne, c'est automatique
si la cellule active est vide on sort
si l'on ne met pas une valeur numérique dans l'InputBox, message d'alerte
si l'InputBox est vide on sort
si le nombre de fin est plus petit que le début on sort

Option Explicit
Dim var As String 'valeur cellule active
Dim debut As Integer 'numerique cellule active
Dim ligne As Integer ' ligne cellule active
Dim fin  As Integer 'numerique de fin
Dim result As Integer 'nombre de ligne à ajouter
Dim colonne As String 'colonne en lettre
Sub dupliquerlignes()
var = ActiveCell.Value
If var = "" Then Exit Sub
fin = Application.InputBox("N °DE FIN", "Saisie numérique", Type:=1)
If Len(fin) = 0 Then Exit Sub
extractionMots
ligne = ActiveCell.Row
colonne = Split(Columns(ActiveCell.Column).Address(ColumnAbsolute:=False), ":")(1) 'colonne en lettre
If debut > fin Then Exit Sub
result = fin - debut 'nombre de ligne à ajouter
ActiveCell.AutoFill Destination:=Range(colonne & ligne & ":" & colonne & ligne + result), Type:=xlFillDefault
End Sub
'Extraire les données séparées par un espace dans une chaine de caractères
Sub extractionMots()
    Dim Tableau() As String
    Dim i As Integer
    'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(var, " ")
    '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
    debut = Tableau(0) 'numerique cellule active
End Sub


Voilà

@+ Le Pivert
Bonjour ,
Merci pour votre réactivité :D.
J'ai pas pensé a l'idée , debut < fin :D merci :)
Bonne début de semaine :D
Commenter la réponse de cs_Le Pivert