XL 2019 Sélectionner dernières cellules non vide sur une ligne (VBA)

[bluesky12000]

Bonjour à tous,

J'ai un problème qui doit être très simple à régler mais je débute en VBA sur Excel.
J'ai un tableau qui va de A1 à H1 et qui s'étend vers le bas au fur et à mesure.
Je souhaite créer un bouton pour supprimer la dernière ligne qui contient des données mais mon code efface uniquement la dernière cellule A au lieu d'aller jusqu'à H

Sheets("Nom de la feuille").Select
Range("A1:H1").End(xlDown).Select
Selection.ClearContents

Merci pour votre aide,

 

[Staple1600]

Re

=>bluesky
Test OK, sur ton fichier exemple

Sub test_ok()
Sheets("Guides").Unprotect
Ajout_Ligne Sheets("Guides").ListObjects("Table54")
Sheets("Guides").Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
End Sub
Private Sub Ajout_Ligne(Tableau As ListObject)
'ajoute une ligne en bas du tableau designé
Tableau.ListRows.Add
End Sub

 

[bluesky12000]

Merci Staple, ça va me servir dans le suite de mon projet

 

[soan]

Bonjour Bluesky, Staple, le fil,

ton fichier du post #29 en retour.

j'me suis permis d'faire quelques petites retouches dans tout
ton code VBA. (y'en avait, du boulot ! c'est l'cas d'le dire ! )

Module 1 :

Option Explicit

Sub AjouterGuide()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    Dim lig&: Application.ScreenUpdating = 0: .Unprotect
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then lig = 2 _
        Else .ListRows.Add: lig = .ListRows.Count + 1
    End With
  End With
  With Cells(lig, 2)
    .Value = "Guide"     'Type
    .Offset(, 1) = [L12] 'Pays
    .Offset(, 2) = [L15] 'Ville
    .Offset(, 3) = [L18] 'Nom
    .Offset(, 4) = [L21] 'Prestataire
    .Offset(, 5) = [L24] 'Durée
    .Offset(, 6) = [L27] 'Prix
    With .Offset(, 8)
      .NumberFormat = "dd/mm/yy hh:mm"
      .Value = Now 'Date et h d'ajout
    End With
  End With
  ActiveSheet.Protect
End Sub

Module 2 :

Option Explicit

Sub EffacerDerniereLigne()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    Dim msg$, k&: Application.ScreenUpdating = 0
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then _
        MsgBox "Aucune entrée à supprimer.", 48, "Base de données vide": Exit Sub
      .Parent.Unprotect
      With .DataBodyRange
        k = .Rows.Count
        With .Rows(k)
          msg = "Êtes-vous sûr de vouloir supprimer la ligne n° " & k + 1 & " ?" _
            & vbLf & vbLf & "Guide : " & .Columns(6) & " ; Durée : " _
            & .Columns(7) & " ; Prix : " & Format(.Columns(8), "0.00 €")
          If MsgBox(msg, 4, "Demande de confirmation") = 6 Then .Delete
        End With
      End With
    End With
    .Protect
  End With
End Sub

Module3 :

Option Explicit

Sub Guide_Effacer_Pays()
  [L12].ClearContents
End Sub

Sub Guide_Effacer_Ville()
  [L15].ClearContents
End Sub

Sub Guide_Effacer_Nom()
  [L18].ClearContents
End Sub

Sub Guide_Effacer_Prestataire()
  [L21].ClearContents
End Sub

Sub Guide_Effacer_Durée()
  [L24].ClearContents
End Sub

Sub Guide_Effacer_Prix()
  [L27].ClearContents
End Sub

Sub Guide_Effacer_Formulaire()
  Dim lig As Byte: Application.ScreenUpdating = 0
  For lig = 12 To 27 Step 3
    Cells(lig, 12).ClearContents
  Next lig
  [L12].Select
End Sub

Module4 :

Sub Macro1()
  ActiveCell.FormulaR1C1 = Now
End Sub

---

j'ai déjà tout testé, et ça marche impeccable ;
à toi l'honneur de faire pareil !

---

n'oublie pas de regarder ces 2 cas particuliers :

1) teste de nouveau EffacerDernièreLigne() quand
le tableau est vide ➯ "Base de données vide" et :
"Aucune entrée à supprimer."

2) teste AjouterGuide() même quand au tout début
le tableau est entièrement vide ; tu verras que ça
marche correctement ; idem quand y'a une 1ère
ligne, puis une seconde, etc...

---

remarque pour la sub AjouterGuide()

pour la colonne J "Date d'ajout", si vraiment tu voulais
la date ET l'heure, alors c'est bien .Value = Now ; sinon,
tu peux remplacer par : .Value = Date

mais dans ce cas, bien sûr, tu dois changer le format :
au lieu de : .NumberFormat = "dd/mm/yy hh:mm"
met : .NumberFormat = "dd/mm/yy"

---

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

 

[bluesky12000]

d With End With End With

Bonjour Bluesky, Staple, le fil,

ton fichier du post #34 en retour.

j'me suis permis d'faire quelques petites retouches dans tout
ton code VBA. (y'en avait, du boulot ! c'est l'cas d'le dire ! )

Module 1 :

Option Explicit

Sub AjouterGuide()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    Dim lig&: Application.ScreenUpdating = 0: .Unprotect
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then lig = 2 _
        Else .ListRows.Add: lig = .ListRows.Count + 1
    End With
  End With
  With Cells(lig, 2)
    .Value = "Guide"     'Type
    .Offset(, 1) = [L12] 'Pays
    .Offset(, 2) = [L15] 'Ville
    .Offset(, 3) = [L18] 'Nom
    .Offset(, 4) = [L21] 'Prestataire
    .Offset(, 5) = [L24] 'Durée
    .Offset(, 6) = [L27] 'Prix
    With .Offset(, 8)
      .NumberFormat = "dd/mm/yy hh:mm"
      .Value = Now 'Date et h d'ajout
    End With
  End With
  ActiveSheet.Protect
End Sub

Module 2 :

Option Explicit

Sub EffacerDerniereLigne()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    Dim msg$, k&: Application.ScreenUpdating = 0
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then _
        MsgBox "Aucune entrée à supprimer.", 48, "Base de données vide": Exit Sub
      .Parent.Unprotect
      With .DataBodyRange
        k = .Rows.Count
        With .Rows(k)
          msg = "Êtes-vous sûr de vouloir supprimer la ligne n° " & k + 1 & " ?" _
            & vbLf & vbLf & "Guide : " & .Columns(6) & " ; Durée : " _
            & .Columns(7) & " ; Prix : " & Format(.Columns(8), "0.00 €")
          If MsgBox(msg, 4, "Demande de confirmation") = 6 Then .Delete
        End With
      End With
    End With
    .Protect
  End With
End Sub

Module3 :

Option Explicit

Sub Guide_Effacer_Pays()
  [L12].ClearContents
End Sub

Sub Guide_Effacer_Ville()
  [L15].ClearContents
End Sub

Sub Guide_Effacer_Nom()
  [L18].ClearContents
End Sub

Sub Guide_Effacer_Prestataire()
  [L21].ClearContents
End Sub

Sub Guide_Effacer_Durée()
  [L24].ClearContents
End Sub

Sub Guide_Effacer_Prix()
  [L27].ClearContents
End Sub

Sub Guide_Effacer_Formulaire()
  Dim lig As Byte: Application.ScreenUpdating = 0
  For lig = 12 To 27 Step 3
    Cells(lig, 12).ClearContents
  Next lig
  [L12].Select
End Sub

Module4 :

Sub Macro1()
  ActiveCell.FormulaR1C1 = Now
End Sub

---

j'ai déjà tout testé, et ça marche impeccable ;
à toi l'honneur de faire pareil !

---

n'oublie pas de regarder ces 2 cas particuliers :

1) teste de nouveau EffacerDernièreLigne() quand
le tableau est vide ➯ "Base de données vide" et :
"Aucune entrée à supprimer."

2) teste AjouterGuide() même quand au tout début
le tableau est entièrement vide ; tu verras que ça
marche correctement ; idem quand y'a une 1ère
ligne, puis une seconde, etc...

---

remarque pour la sub AjouterGuide()

pour la colonne J "Date d'ajout", si vraiment tu voulais
la date ET l'heure, alors c'est bien .Value = Now ; sinon,
tu peux remplacer par : .Value = Date

mais dans ce cas, bien sûr, tu dois changer le format :
au lieu de : .NumberFormat = "dd/mm/yy hh:mm"
met : .NumberFormat = "dd/mm/yy"

---

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

Merci beaucoup Soan, c'est super gentil de ta part d'avoir fait tout ça

Ta simplification des codes m'est très utile comme je découvre le VBA. Mes codes étaient fait surtout manuellement via l'enregistreur de macro. Je retiens l'utilisation des crochets qui permettent de vraiment alléger le code.

Concernant la date d'ajout, c'était bien volontaire d'inclure l'heure pour que chaque ajout soit vraiment unique en plus du code en colonne A (si besoin pour faire une distinction supplémentaire).

Hier, je cherchais comment exécuter le code seulement si toutes les cases du formulaires étaient remplies.
J'ai commencé par faire un ISTEXT/IS NUMBER sous chaque cellule à remplir et j'ai écrit ce code non sans difficultés. Je n'arrivais pas à intégrer à la fois le Msbox et le End Sub. J'ai compris après qu'il fallait mettre un End if sous le End Sub. Pourquoi ce n'était pas obligatoire sur l'étape du dessus ?

Sub AjouterGuide()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    If [L13] Or [L16] Or [L19] Or [L22] Or [L25] Or [L28] = False Then
    MsgBox ("Le formulaire n'est pas complet")
    Exit Sub
    End If

    Dim lig&: Application.ScreenUpdating = 0: .Unprotect
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then lig = 2 _
        Else .ListRows.Add: lig = .ListRows.Count + 1
        End With
    End With

  With Cells(lig, 2)
    .Value = "Guide"     'Type
    .Offset(, 1) = [L12] 'Pays
    .Offset(, 2) = [L15] 'Ville
    .Offset(, 3) = [L18] 'Nom
    .Offset(, 4) = [L21] 'Prestataire
    .Offset(, 5) = [L24] 'Durée
    .Offset(, 6) = [L27] 'Prix
    With .Offset(, 8)
      .NumberFormat = "dd/mm/yy hh:mm"
      .Value = Now 'Date et h d'ajout
    End With
  End With
  ActiveSheet.Protect
End Sub

 

[soan]

Bonsoir bluesky12000,

tu as écrit : « J'ai compris après qu'il fallait mettre un End if sous le End Sub.
Pourquoi ce n'était pas obligatoire sur l'étape du dessus ? »

non, il s'agit de mettre un End If sous le If correspondant,
par exemple comme ceci :

If lig > 3 Then
  'instruction 1
  'instruction 2
  'instruction 3
End If

les 3 instructions sont exécutées si lig > 3.

---

bien sûr, ça marche aussi s'il y a une seule instruction :

If lig > 3 Then
  'instruction unique
End If

l'instruction unique est exécutée si lig > 3.

---

mais s'il y a une seule instruction, autant éviter de mettre
un bloc If .. End If ; tu peux mettre plus simplement :

If lig > 3 Then instruction

bien sûr, instruction doit être une instruction VBA valide.

---

s'il y a une seule instruction mais que la ligne du If est trop longue,
tu peux la mettre sur 2 lignes à condition de terminer la 1ère ligne
par " _" (1 caractère espace et 1 caractère souligné) ; le "_" est appelé
« caractère de continuation de ligne » : il indique au compilateur
que la suite de la ligne logique courante se trouve sur la ligne
physique suivante.

je l'avais fait par exemple ici :

If .DataBodyRange Is Nothing Then _
  MsgBox "Aucune entrée à supprimer.", 48, "Base de données vide": Exit Sub

ces 2 lignes physiques sont considérées comme une seule ligne logique,
donc y'a pas besoin de End If car c'est pas un bloc If .. End If.

c'est ça qui a dû te faire penser qu'il manquait un End If alors que
c'était pas le cas.

---

le caractère de continuation de ligne peut être utilisé même si l'instruction
n'est pas un If, comme tu as pu le voir pour ces 3 lignes :

msg = "Êtes-vous sûr de vouloir supprimer la ligne n° " & k + 1 & " ?" _
  & vbLf & vbLf & "Guide : " & .Columns(6) & " ; Durée : " _
  & .Columns(7) & " ; Prix : " & Format(.Columns(8), "0.00 €")

soan

 

[soan]

Bonjour bluesky12000,

lis d'abord mon post précédent.

tu as écrit : « comment exécuter le code seulement
si toutes les cases du formulaires sont remplies ? »

la solution que tu as utilisée n'est pas correcte :

    If [L13] Or [L16] Or [L19] Or [L22] Or [L25] Or [L28] = False Then
    MsgBox ("Le formulaire n'est pas complet")
    Exit Sub
    End If

à la place, sans tes ISTEXT / ISNUMBER, je propose :

    If [L12] = "" Or [L15] = "" Or [L18] = "" Or [L21] = "" Or _
       [L24] = "" Or Val(Replace$([L27], ",", ".")) = 0 Then
      MsgBox "Le formulaire n'est pas complet.": Exit Sub
    End If

d'où ce code VBA complet :

Option Explicit

Sub AjouterGuide()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    If [L12] = "" Or [L15] = "" Or [L18] = "" Or [L21] = "" Or _
       [L24] = "" Or Val(Replace$([L27], ",", ".")) = 0 Then
      MsgBox "Le formulaire n'est pas complet.": Exit Sub
    End If
    Dim lig&: Application.ScreenUpdating = 0: .Unprotect
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then lig = 2 _
        Else .ListRows.Add: lig = .ListRows.Count + 1
    End With
  End With
  With Cells(lig, 2)
    .Value = "Guide"     'Type
    .Offset(, 1) = [L12] 'Pays
    .Offset(, 2) = [L15] 'Ville
    .Offset(, 3) = [L18] 'Nom
    .Offset(, 4) = [L21] 'Prestataire
    .Offset(, 5) = [L24] 'Durée
    .Offset(, 6) = [L27] 'Prix
    With .Offset(, 8)
      .NumberFormat = "dd/mm/yy hh:mm"
      .Value = Now 'Date et h d'ajout
    End With
  End With
  ActiveSheet.Protect
End Sub

---

éventuellement, si tu veux une longueur minimum
de 3 caractères pour tes 5 valeurs de texte, tu peux
utiliser ceci :

    If Len([L12]) < 3 Or Len([L15]) < 3 Or Len([L18]) < 3 _
       Or Len([L21]) < 3 Or Len([L24]) < 3 Or Val( _
       Replace$([L27], ",", ".")) = 0 Then
      MsgBox "Le formulaire n'est pas complet.": Exit Sub
    End If

soan

 

[bluesky12000]

Merci Beaucoup Soan, c'est génial

 

[bluesky12000]

Bonjour bluesky12000,

lis d'abord mon post précédent.

tu as écrit : « comment exécuter le code seulement
si toutes les cases du formulaires sont remplies ? »

la solution que tu as utilisée n'est pas correcte :

    If [L13] Or [L16] Or [L19] Or [L22] Or [L25] Or [L28] = False Then
    MsgBox ("Le formulaire n'est pas complet")
    Exit Sub
    End If

à la place, sans tes ISTEXT / ISNUMBER, je propose :

    If [L12] = "" Or [L15] = "" Or [L18] = "" Or [L21] = "" Or _
       [L24] = "" Or Val(Replace$([L27], ",", ".")) = 0 Then
      MsgBox "Le formulaire n'est pas complet.": Exit Sub
    End If

d'où ce code VBA complet :

Option Explicit

Sub AjouterGuide()
  With ActiveSheet
    If .Name <> "Guides" Then Exit Sub
    If [L12] = "" Or [L15] = "" Or [L18] = "" Or [L21] = "" Or _
       [L24] = "" Or Val(Replace$([L27], ",", ".")) = 0 Then
      MsgBox "Le formulaire n'est pas complet.": Exit Sub
    End If
    Dim lig&: Application.ScreenUpdating = 0: .Unprotect
    With .ListObjects("Table54")
      If .DataBodyRange Is Nothing Then lig = 2 _
        Else .ListRows.Add: lig = .ListRows.Count + 1
    End With
  End With
  With Cells(lig, 2)
    .Value = "Guide"     'Type
    .Offset(, 1) = [L12] 'Pays
    .Offset(, 2) = [L15] 'Ville
    .Offset(, 3) = [L18] 'Nom
    .Offset(, 4) = [L21] 'Prestataire
    .Offset(, 5) = [L24] 'Durée
    .Offset(, 6) = [L27] 'Prix
    With .Offset(, 8)
      .NumberFormat = "dd/mm/yy hh:mm"
      .Value = Now 'Date et h d'ajout
    End With
  End With
  ActiveSheet.Protect
End Sub

---

éventuellement, si tu veux une longueur minimum
de 3 caractères pour tes 5 valeurs de texte, tu peux
utiliser ceci :

    If Len([L12]) < 3 Or Len([L15]) < 3 Or Len([L18]) < 3 _
       Or Len([L21]) < 3 Or Len([L24]) < 3 Or Val( _
       Replace$([L27], ",", ".")) = 0 Then
      MsgBox "Le formulaire n'est pas complet.": Exit Sub
    End If

soan

Bonsoir Soan,

J'espère que tu vas bien,

Je suis de retour avec ton code, je me casse la tête dessus et toutes mes recherches sont infructueuses.

On va dire que [L27] n'est plus un prix mais un lien https. Je souhaiterais, lorsque que je copie ce lien dans le tableau en faisait offset(,6) que le format de cette cellule soit un lien hypertexte mais avec le texte "lien" à la place de l'url. Est-ce possible ?

J'ai compris qu'il fallait utiliser .Hyperlinks.Add en VBA mais dans mon cas je n'arrive pas à l'intégrer avec value =

Merci beaucoup pour ton aide

 

[soan]

Bonjour bluesky,

je vais bien, merci.

pour ton exo, essaye en remplaçant ça :

    .Offset(, 6) = [L27] 'Prix

par ça :

    .Hyperlinks.Add Anchor:=.Offset(, 6), _
      Address:="https://abcdef.com", _
      ScreenTip:="texte de l'infobulle", _
      TextToDisplay:="lien"

bien sûr, tu dois mettre le lien https correct
à la place de "abcdef.com"

soan

 

[bluesky12000]

ahhh c'est parfait, merci Soan
J'ai mis comme adresse = [L27] et ça fonctionne. J'avais peur que le lien soit dynamique mais comme c'est inclus dans un with, c'est bien la valeur à l'instant t.

Merci encore et bonne soirée