[EXCEL-2016][WIN7] - Sélection manuelle des lignes à supprimer

Bonjour @ tous,

J'ai un tableau avec une en-tête sur la ligne 1.

Les lignes du tableau vont de la ligne 2 à 15.

Je souhaite que l'utilisateur, après avoir cliqué sur le bouton "supprimer", puisse à l'invite choisir les lignes à supprimer.

Ex: les lignes à supprimer sont 3, 7, 11 et 12.

    Range("3:3,7:7,11:11,12:12").Delete Shift:=xlUp

=>> Par contre, l'utilisateur ne doit choisir qu'entre les lignes 2 et 15 du tableau, ni plus, ni moins.

J'ai essayé de protéger la feuille, en ne laissant que les lignes modifiables, mais la macro supprime quand même les lignes protégées.

Merci de votre aide précieuse.

LePrince

Rebonjour,

J'ai regardé ci et là sur le forum, et j'ai trouvé ce https://forum.excel-pratique.com/viewtopic.php?f=2&t=118099&p=717257&hilit=refedit#p717257 qui m'a mit sur la piste.

J'y ai trouvé ce fichier https://forum.excel-pratique.com/download/file.php?id=218753

J'ai repris de ce fichier le userform RefEdit que j'ai importé dans mon fichier et que j'ai adapté à mon besoin.

Ci-dessous le code du userform qui fonctionne chez moi :

Option Explicit

Private Sub CommandButton1_Click()
Dim strAddress As String, rng As Range, bSet As Boolean
Dim NomFeuil As String
Dim LongNomFeuil As Integer

Dim DerniereCell As Range
Dim DerniereLigne As Integer
Dim DerniereColonne As Integer
Dim NbrLigneTbl As Integer
Set DerniereCell = Cells.EntireRow.Find(What:="DerniereCellule", LookAt:=xlWhole)
DerniereLigne = DerniereCell.Row - 1
DerniereColonne = DerniereCell.Column - 1
NbrLigneTbl = DerniereLigne - 7

    strAddress = RefEdit1.Value

    LongNomFeuil = InStr(strAddress, "!")
    NomFeuil = Left(strAddress, LongNomFeuil)
    strAddress = Replace(strAddress, NomFeuil, "")
    strAddress = Replace(strAddress, ";", ",")

Dim PosVirg As Long
Dim LongRngCell As Long
Dim VerifLign As String
Dim strAddress2 As String
Dim rng2 As Range
strAddress2 = strAddress
    Do
        PosVirg = InStr(strAddress2, ",")
            If PosVirg = 0 Then
                VerifLign = strAddress2
            Else
                LongRngCell = PosVirg - 1
                VerifLign = Left(strAddress2, LongRngCell)
            End If
        Set rng2 = Range(VerifLign)
Dim LignP1 As String
Dim LignP2 As String
Dim VerifSiCell As String
Dim VerifSiCol As String
Dim PosDeuxPt As Long
Dim NbrDollarsP1 As Long
Dim NbrDollarsP2 As Long
    PosDeuxPt = InStr(VerifLign, ":")
    LignP1 = Left(VerifLign, PosDeuxPt - 1)
    LignP2 = Right(VerifLign, Len(VerifLign) - PosDeuxPt)
    NbrDollarsP1 = nbOccurences("$", LignP1)
    NbrDollarsP2 = nbOccurences("$", LignP2)
    LignP1 = Replace(LignP1, "$", "")
    LignP2 = Replace(LignP2, "$", "")
            If NbrDollarsP1 > 1 Or NbrDollarsP2 > 1 Then
                MsgBox ("Vous avez sélectionné une ou plusieurs 'cellule'" & vbCrLf & vbCrLf & "Veuillez sélectionner une ou plusieurs 'lignes' svp.")
                Unload Me
                Exit Sub
            End If
            If Not IsNumeric(LignP1) Or Not IsNumeric(LignP2) Then
                MsgBox ("Vous avez sélectionné une ou plusieurs 'colonnes'" & vbCrLf & vbCrLf & "Veuillez sélectionner une ou plusieurs 'lignes' svp.")
                Unload Me
                Exit Sub
            End If
            If rng2.Row < 8 Or rng2.Row > DerniereLigne Or LignP1 < 8 Or LignP1 > DerniereLigne Or LignP2 < 8 Or LignP2 > DerniereLigne Then
                MsgBox ("Ce tableau a " & NbrLigneTbl & " ligne(s) après la ligne 7, et avant la ligne " & DerniereLigne + 1 & "." & vbCrLf & vbCrLf & "Les lignes sélectionnées sont hors du tableau" & vbCrLf & vbCrLf & "Veuillez refaire la sélection svp.")
                Unload Me
                Exit Sub
            End If
        strAddress2 = Right(strAddress2, Len(strAddress2) - PosVirg)
    Loop While PosVirg <> 0

    On Error Resume Next
    bSet = IsObject(Range(strAddress))
    On Error GoTo 0

    If bSet = False Then
        MsgBox "Sélection non valide.", 64, "Information"
        With RefEdit1
            .Value = vbNullString
            .SetFocus
        End With
        Exit Sub
    End If

    Set rng = Range(strAddress)
    'Range("9:9,13:13,17:17,18:18").Select
    With rng
        .Delete Shift:=xlUp
        '.ClearContents
        'etc...
    End With
    Unload Me
End Sub

Pour lancer le code, j'ai mis cette ligne dans ma MACRO :

UserForm1.Show

Il aurait été possible également de la mettre dans un module :

Sub tester RefEdit()
UserForm2.Show
End Sub

Merci à tous !

LePrince