ForulE EXCEL

Bonsoir,
J'ai besoin de vous !

J'ai une commande dans vb qui permet de supprimer et d'ajouter des lignes sur excel. Mais j'aimerais que, dès qu'on arrive à la ligne 13 ça ne supprime plus de lignes mais ça efface juste la valeur qu'il y a à l'intérieur !! donc si j<13 effacer juste les valeurs dans les lignes ( et non pas supprimer !)

voila...
Configuration: Windows XP
Firefox 2.0.0.12

3 réponses

  1. Contributeur
    bonjour

    En changeant cette partie, cela devrait te donner satisfaction
    If Worksheets("EstimChargeSSE-CTP").Range("C" & j).Value = .List(i) Then
    
       If j < 12 Then
         Worksheets("EstimChargeSSE-CTP").Cells(j, 1).EntireRow.ClearContents
       Else
         Worksheets("EstimChargeSSE-CTP").Cells(j, 1).EntireRow.Delete
    '     updateIndexDelete (last) ' enlever la mise en commentaire si tu ne veux que les suppressions
       End If
    '   updateIndexDelete (last)  ' enlever la mise en commentaire si tu  veux toutes les modifications
    End If
    
    0
    1. je n'arrive pas à envoyer mon fichier :s
      0
      1. Poste le module qui existe déjà, qu'on puisse juste le modifier sans tout bouleverser!
        0
        1. Bon j'ai envoyé la feuille excel pour que tu comprennes mieux... Enfaite j'ai une listebox sur vb et lorsque je sélectionne un ou plusieurs élément , ce que je sélectionne va se mettre soit ds "REALISATION" "ou 'DOCUMENTATION" donc si ya plus de 2 choix tu comprend bien que ça ajoute une ligne automatiquement ! Ensuite après avoir ajouté ce que je veus , je veus pouvoir supprimer ! donc j'ai réussi . Mais seulement je veus toujours qu'il reste o minimum 2lignes ds Réalisation , Support et Documentation ( partout quoi ! ) donc il faut trouver une formule qui supprime juste à temps qu'il reste que 2 lignes ( et si il reste que 2 lignes il faut que les valeurs ds les lignes soient donc EFFAcées , si on clique sur supprimer ! )

          voici le code pour le clique ajouter une ligne :

          rivate Sub CmdAjouter1_Click()
          Dim i As Integer
          Dim j As Integer
          Dim first As Integer
          Dim last As Integer

          With ListBox1
          For i = 0 To .ListCount - 1

          If .Selected(i) Then
          first = determineWhereToWrite(.List(i))
          j = first
          last = LastLine(j)

          Do While Worksheets("EstimChargeSSE-CTP").Range("C" & j).Value <> ""
          j = j + 1
          Loop

          If Not doesExist(first, last, .List(i), "DU EMULATOR") Then
          If j > last Then
          Worksheets("EstimChargeSSE-CTP").Cells(j, 1).EntireRow.Insert
          Worksheets("EstimChargeSSE-CTP").Range("F" & j).FillDown
          updateIndexAdd (last)
          End If
          Worksheets("EstimChargeSSE-CTP").Range("B" & j).Value = "DU EMULATOR"
          Worksheets("EstimChargeSSE-CTP").Range("C" & j).Value = .List(i)
          Worksheets("EstimChargeSSE-CTP").Range("E" & j).Value = ReturnNbJour(.List(i))

          End If
          End If
          Next
          End With

          End Sub

          ET celui pour supprimer :

          Private Sub cmdSupprimer1_Click()
          Dim i As Integer
          Dim j As Integer
          Dim first As Integer
          Dim last As Integer

          With ListBox1
          For i = 0 To .ListCount - 1
          If .Selected(i) Then

          first = determineWhereToWrite(.List(i))
          j = first
          last = LastLine(j)

          Do While Worksheets("EstimChargeSSE-CTP").Range("C" & j).Value <> ""

          If Worksheets("EstimChargeSSE-CTP").Range("C" & j).Value = .List(i) Then
          Worksheets("EstimChargeSSE-CTP").Cells(j, 1).EntireRow.Delete
          updateIndexDelete (last)
          ' Else
          ' If j < 12 Then
          ' If Worksheets("EstimChargeSSE-CTP").Range("C" & j).Value = .List(i) Then
          ' Worksheets("EstimChargeSSE-CTP").Cells(j, 1).EntireRow.ClearContents
          ' End If
          ' End If
          End If

          j = j + 1
          Loop
          End If

          Next
          End With
          End Sub

          miss_O_sixty@hotmail.com si ta rien compris lol
          0