Code compliqué

Le 20/12/2014 à 18:02

bonjour,

j ai un tableau excel avec des formules fonctionnant par lignes paires et impaires.

j ai la possibilité d ajouter ou de retirer des lignes.

le bouton de commande que je veut installer doit prendre en compte la cellule active que je sélectionne , par box me demander la confirmation de suppression,me demander de choisir une seconde ligne a supprimer afin de préserver l intégrité de mes formules, et supprimer la ligne choisie ou dans le cas contraire me demander a nouveau de choisir une ligne a supprimer.

voili voila.

Le 20/12/2014 à 22:05

Hello

JE pense que cela est réalisable je pense.

Merci de joindre ton fichier afin de travailler dessus stp.

Cdt,

Le 20/12/2014 à 22:21

voila merci.

7classeur3.xlsx (233.70 Ko)
Le 21/12/2014 à 01:30

Bonsoir,

Voici ma proposition en PJ.

Voici les explications de fonctionnement :

Vous êtes sur une ligne

Vous lancer le bouton supprimer la ligne

Un userform apparait.

Il vous propose par défaut :

  • il affiche la ligne actuelle
  • il détecte si c'est une ligne paire ou impaire ( via des boutons à cocher)
  • il vous propose une ligne à supprimer ( ligne actuelle + 2)
  • sont chargés dans la liste déroulante des lignes allant de 1 à 341 pour impaire ( modifiable dans code) -> que des nombres impaires
  • sont chargés dans la liste déroulante des lignes allant de 2 à 340 pour paire ( modifiable dans code) -> que des nombres pairs

Cependant , vous pouvez :

  • modifier les lignes qui apparaissent dans la liste déroulante : passer de paire à impaire et vice versa et sélectionner paire et impaire
  • ne sélectionner aucune seconde ligne à supprimer via bouton à cocher aucune

Pour confirmer suppression :

Il y a un bouton :

Il supprimera la ligne actuelle + la ligne se trouvant dans la liste déroulante

Si bouton aucun coché, juste ligne actuelle sera supprimée

Voila

A votre disposition pour toute question

Voici le code :

Private Sub CheckBox3_Click()
'lorsqu'on selectionne aucune seconde ligne à delete

CheckBox1.Value = False
CheckBox2.Value = False
ComboBox1.Clear

End Sub

Private Sub CommandButton1_Click()
'validation Suppression Lignes

'Suppression Ligne Active
    Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
    Selection.Delete Shift:=xlUp

'si pas de seconde ligne à delete
If CheckBox3.Value = True Then
ComboBox1.Value = ""
GoTo achieve
End If

'Suppression Ligne selectionnée combobox
'-1 car ligne deleté juste au dessus
    Rows((ComboBox1.Value - 1) & ":" & (ComboBox1.Value - 1)).Select
    Selection.Delete Shift:=xlUp

achieve:

'Message Validation
If CheckBox3.Value = False Then
MsgBox " Les lignes suivantes ont bien été supprimées :" & Chr(10) & Chr(10) & "Ligne : " & TextBox1.Value & Chr(10) & "Ligne : " & ComboBox1.Value
Else
MsgBox " La ligne suivante a bien été supprimée :" & Chr(10) & Chr(10) & "Ligne : " & TextBox1.Value
End If

End Sub

Public Sub CommandButton2_Click()
'Refresh gestion lignes impaires / paires sur proposition textbox

Dim result, dep

' #####Données utilisateur##### à modifier ci dessous

'# Si ligne paire
Debut_proposition_paire = 2
max_proposition_paire = 340
'# Si ligne impaire
Debut_proposition_impaire = 1
max_proposition_impaire = 341
'# Si MIX
Debut_proposition_mix = 1
max_proposition_mix = 341

' #####Données utilisateur##### à modifier ci dessus

' si aucune ligne à deleter
If CheckBox3.Value = True Then
ComboBox1.Value = ""
GoTo noth_to_do
End If
'mise à zero combobox
ComboBox1.Clear

'Determiner si ligne charger est pair ou impair pour proposer une compensation logique
If CheckBox1.Value = True Then
result = "Paire"
Else
result = "Impaire"
End If

'interception si deux cochés
If CheckBox1.Value = True And CheckBox2 = True Then
result = "Mix"
End If

'Chargement des valeurs
If result = "Paire" Then
dep = Debut_proposition_paire
fin = max_proposition_paire
Else
dep = Debut_proposition_impaire
fin = max_proposition_impaire
End If

'interception si deux cochés
If result = "Mix" Then
dep = Debut_proposition_mix
fin = max_proposition_mix
End If

'Chargement textbox
If result = "Paire" Or result = "Impaire" Then
For i = dep To fin Step 2
ComboBox1.AddItem i
Next
Else
For i = dep To fin Step 1
ComboBox1.AddItem i
Next
End If

'proposition valeur defaut combobox
If result = "Impaire" Then
ComboBox1.Text = TextBox1.Value + 2
Else
ComboBox1.Text = ActiveCell.Row + 1
End If

noth_to_do:
End Sub

Private Sub CommandButton3_Click()
Unload Me
End Sub

Private Sub Frame3_Click()

End Sub

Public Sub UserForm_Initialize() 'chargement ligne active
'LAncement userform gestion suppression
Dim result, dep

' #####Données utilisateur##### à modifier ci dessous

' si aucune ligne à deleter
If CheckBox3.Value = True Then
ComboBox1.Value = ""
GoTo term
End If

'# Si ligne paire
Debut_proposition_paire = 1
max_proposition_paire = 341
'# Si ligne impaire
Debut_proposition_impaire = 2
max_proposition_impaire = 340

' #####Données utilisateur##### à modifier ci dessus

'chargement ligne actuelle
TextBox1.Value = ActiveCell.Row

'raz checkbox1 & 2
CheckBox1.Value = False
CheckBox2.Value = False

'mise à zero combobox
ComboBox1.Clear

'Determiner si ligne charger est pair ou impair pour proposer une compensation logique
If TextBox1.Value Mod 2 = 0 Then
result = "Paire"
CheckBox1.Value = True
CheckBox2.Value = False
Else
result = "Impaire"
CheckBox1.Value = False
CheckBox2.Value = True
End If

'Chargement des valeurs
If result = "Paire" Then
dep = Debut_proposition_paire
fin = max_proposition_paire
Else
dep = Debut_proposition_paire
fin = max_proposition_paire
End If

'Chargement textbox
If result = "Paire" Or result = "Impaire" Then
For i = dep To fin Step 2
ComboBox1.AddItem i
Next
End If

'proposition valeur defaut combobox
ComboBox1.Text = TextBox1.Value + 2

term:
End Sub
13classeur3.xlsm (248.96 Ko)
Le 21/12/2014 à 07:48

merci pour cette excellent travail.

toutefois je souhaite quelque chose de plus simple:

Dim msg As String, title As String, Response As String

Dim style As Integer

Application.ScreenUpdating = False

msg = "Voulez-vous supprimer cette ligne ?"

style = vbYesNo + vbCritical + vbDefaultButton2

title = "Suppression de ligne"

Response = MsgBox(msg, style, title)

If Response = vbYes Then

ActiveCell.EntireRow.Delete

End If

voila je voudrais qu une fois la première ligne supprimé la boite de dialogue me demande une seconde sélection avec une boucle m obligeant a effectuer la seconde sélection.

voili voila

Le 21/12/2014 à 12:11

bonjour

voici

Sub del()

Dim msg As String, title As String, Response As String
Dim style  As Integer
Application.ScreenUpdating = False
msg = "Voulez-vous supprimer cette ligne ?" & Chr(10) & Chr(10) & "Ligne : " & ActiveCell.Row
style = vbYesNo + vbCritical + vbDefaultButton2
title = "Suppression de ligne"
Response = MsgBox(msg, style, title)
If Response = vbYes Then
'Suppression Ligne Active
svg = ActiveCell.Row
'Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
'Selection.Delete Shift:=xlUp
Else
Exit Sub
End If

seconde_ligne:
'proposition seconde ligne
msg = "Merci d'indiquer une seconde ligne à supprimer"
title = "Suppression de ligne"
Response = InputBox(msg, title)

If Response = "" Then
MsgBox " Saisie d'une ligne obligatoire"
GoTo seconde_ligne
End If

'suppression ligne
If Response > svg Then
'MsgBox "sup"
Rows((Response) & ":" & (Response)).Select
Selection.Delete Shift:=xlUp
Rows(svg - 1 & ":" & svg - 1).Select
Selection.Delete Shift:=xlUp
Else
'MsgBox "inf"
Rows(svg & ":" & svg).Select
Selection.Delete Shift:=xlUp
Rows((Response - 1) & ":" & (Response - 1)).Select
Selection.Delete Shift:=xlUp
End If
'Suppression seconde Ligne
'Rows((Response) & ":" & (Response)).Select
'Selection.Delete Shift:=xlUp

If Len(Response) = 2 Or Len(Response) = 2 Then
MsgBox " Ligne        Suppression" & Chr(10) & Chr(10) & "   " & svg & "                          [X]" & Chr(10) & "   " & Response & _
"                        [X]"
Else
MsgBox " Ligne        Suppression" & Chr(10) & Chr(10) & "   " & svg & "                        [X]" & Chr(10) & "   " & Response & _
"                        [X]"
End If

End Sub

cdt,

Le 21/12/2014 à 13:01

merci beaucoup, excelent.

Rechercher des sujets similaires à "code complique"