XL 2019 Ajout d'un bouton DELETE sur mon USF

[Phil Du59]

Bonjour à tous
1°) Sur mon USF je voudrais ajouter un bouton DELETE QSO afin de supprimer moi même la dernière ligne rempli en appuyant sur le bouton si la personne est déjà listé , pour me prévenir j'ai mis une condition en colonne 1 qui me met la case en rouge si déjà enregistré , sur l'image jointe on voit que Paul est listé en 2 et en 5 donc en doublon et en appuyant sur DELETE la dernière ligne soit supprimé . Donc si vous avez le code qui pourrait me faire ça ce serait génial .

2°) Pendant que j'y suis , comment faire pour que mon tableau s'ouvre sur un autre ordi pour que le USF s'adapte à l'écran exemple 15" 17" ou autre
J'attends vos réponses pour déposer mon fichier, Merci pour votre temps , Philippe .

 

[vgendron]

voir PJ
je n'avais remis aucun bouton

 

[job75]

Comme suite aux posts #7 et #8 j'ai revu les macros de l'UserForm :

Private Sub btnAjout_Click() 'Save QSO
Dim lig&
With Sheets("LOG")
    lig = Application.Match("zzz", .[C:C]) + 1
    .Cells(lig, 1).Resize(, 12) = Array("=ROW() - 2", cboActivation, txtQrz, txtRst, Date, Time, cboBand, txtMhz, cboMode, "", "", txtnotes)
End With
txtQrz = ""
txtRst = ""
txtnotes = ""
txtQrz.SetFocus
End Sub

Private Sub CommandButton1_Click() 'DELETE QSO
Dim derlig&
With Sheets("LOG")
    derlig = Application.Match("zzz", .[C:C])
    .Range("A3:M" & derlig).RemoveDuplicates Columns:=3, Header:=xlYes
    If derlig > 3 Then .Range("A3:M3").AutoFill .Range("A3:M" & derlig), xlFillFormats
End With
End Sub

J'ai supprimé la macro Workbook_BeforeSave du ThisWorkbook, elle est maintenant inutile.

 

[Phil Du59]

Comme suite aux posts #7 et #8 j'ai revu les macros de l'UserForm :

Private Sub btnAjout_Click() 'Save QSO
Dim lig&
With Sheets("LOG")
    lig = Application.Match("zzz", .[C:C]) + 1
    .Cells(lig, 1).Resize(, 12) = Array("=ROW() - 2", cboActivation, txtQrz, txtRst, Date, Time, cboBand, txtMhz, cboMode, "", "", txtnotes)
End With
txtQrz = ""
txtRst = ""
txtnotes = ""
txtQrz.SetFocus
End Sub

Private Sub CommandButton1_Click() 'DELETE QSO
Dim derlig&
With Sheets("LOG")
    derlig = Application.Match("zzz", .[C:C])
    .Range("A3:M" & derlig).RemoveDuplicates Columns:=3, Header:=xlYes
    If derlig > 3 Then .Range("A3:M3").AutoFill .Range("A3:M" & derlig), xlFillFormats
End With
End Sub

J'ai supprimé la macro Workbook_BeforeSave du ThisWorkbook, elle est maintenant inutile.

Comme suite aux posts #7 et #8 j'ai revu les macros de l'UserForm :

Private Sub btnAjout_Click() 'Save QSO
Dim lig&
With Sheets("LOG")
    lig = Application.Match("zzz", .[C:C]) + 1
    .Cells(lig, 1).Resize(, 12) = Array("=ROW() - 2", cboActivation, txtQrz, txtRst, Date, Time, cboBand, txtMhz, cboMode, "", "", txtnotes)
End With
txtQrz = ""
txtRst = ""
txtnotes = ""
txtQrz.SetFocus
End Sub

Private Sub CommandButton1_Click() 'DELETE QSO
Dim derlig&
With Sheets("LOG")
    derlig = Application.Match("zzz", .[C:C])
    .Range("A3:M" & derlig).RemoveDuplicates Columns:=3, Header:=xlYes
    If derlig > 3 Then .Range("A3:M3").AutoFill .Range("A3:M" & derlig), xlFillFormats
End With
End Sub

J'ai supprimé la macro Workbook_BeforeSave du ThisWorkbook, elle est maintenant inutile.

Alors comment dire , c'est exactement ce que je voulais, un grand MERCI Job75 et aux autres qui ont répondu à mon post , en plus même si j'oublie de supprimer le doublon de suite je peux le faire plus tard et idem si plusieurs doublon je clique sur DELETE et ça nettoie tous les doubles , super job , encore merci et belle soirée , Philippe .

 

[vgendron]

et ma propostion post 16 ?

 

[Phil Du59]

voir PJ
je n'avais remis aucun bouton

Oupss je n'ai pas reçu sur mon mail , alors oui c'est pas mal non plus et c'est à creuser et modifier , je reviens vers vous demain aprèm car là je suis de sortie , belle soirée

 

[job75]

Je pense cependant que vgendron a tout à fait raison d'empêcher l'entrée des doublons.

Dans les fichiers joints il n'y a maintenant qu'une seule macro dans l'UserForm, le bouton DELETE QSO a été supprimé :

Private Sub btnAjout_Click() 'Save QSO
Dim c As Range, lig&
With Sheets("LOG")
    Set c = .[C:C].Find(txtQrz, , xlValues, xlWhole)
    If Not c Is Nothing Then
        MsgBox txtQrz & " existe déjà en " & c.Address(0, 0) & " !", 48, "Doublon"
    Else
        lig = Application.Match("zzz", .[C:C]) + 1
        .Cells(lig, 1).Resize(, 12) = Array("=ROW() - 2", cboActivation, txtQrz, txtRst, Date, Time, cboBand, txtMhz, cboMode, "", "", txtnotes)
    End If
End With
txtQrz = ""
txtRst = ""
txtnotes = ""
txtQrz.SetFocus
End Sub

A vous de choisir entre cette solution et celle du post #17.