XL 2013 (merci a si...)(RESOLU)remonter ligne basse sans la bordure basse

[grisan29]

bonjour a tous
je suis cours de modification complète de mon classeur et la je bute surement a cause des cellules nommées qui sont dessous,
dans l'exemple que je vais vous présenter, j'ai un userform qui me sert a déplacer une ligne dans le devis
en choisissant dans la combobox dans quelle partie je veux la déplacée
une fois la partie choisie il le n° de la 1 ere ligne de cette partie qui s'affiche dans le textbox de droite ou je peux changer le n° si je veux pas que ma ligne se déplace dans celle afficher au départ
cet userform fonctionne très bien tant que la ligne a déplacer ne se trouve pas en bas du tableau, car dans ce cas le déplacement de la ligne amène aussi les bordures
et c'est la que je fait appel a vos lumières, car il ne faut pas que les bordures basses se déplace avec la ligne ou les lignes
en fait ce que j’essaie de faire c'est de recréer la bordure si elle a été effacer

comme ce que j'ai dit doit etre un peu flou, je vais joindre un classeur exemple

 

[eriiic]

Bonjour,

il n'y a pas la partie 'construction' de ta facture.
Cependant j'ai l'impression que tu insères des lignes au fur et à mesure du besoin.
Les mises en formes étant toujours emmenées, autant que tu prévois une dernière ligne supplémentaire toujours vide (et idem pour la 1ère à mon avis), dont tu peux réduire la hauteur.
Et plus de pb...
eric

 

[grisan29]

bonjour eriiic
merci d'accodrer un peu de ton temps a ce souci
donc quand je fais un devis, la longueur d'ajout de lignes importe peu qu'il y ai 2 comme 200 le bas de page suit
mais quand je m'aperçois avoir oublier une ligne dans le devis n'importe ou je suit la procédure d'ajout de ligne puis après je remonte la ligne, voici le code originel qui fonctionne bien, mais a 2 défauts
1 quand c'est la dernière ligne il remonte la ligne correctement mais en emportant la bordure basse
2 dans le même temps en remontant la ligne le format des lignes descendante est modifié comme celle qui juste sous la 2ème partie "testpour sous total" le sera pour le test

Private Sub CommandButton1_Click()
Dim r As Integer
r = ActiveCell.Row
   Rows(r & ":" & r).Select
   Selection.Copy ': Exit Sub

   'If Cb_ligne.Text = 19 Then Cb_ligne.Text = 20
    Rows(Cb_ligne.Text + 1 & ":" & Cb_ligne.Text + 1).Select
 
    Selection.Insert Shift:=xlDown
    If r < Cb_ligne.Text Then
    Rows(r & ":" & r).Select
    Else
    Rows(r + 1 & ":" & r + 1).Select
    End If
 
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
Call mise_a_jour_cb
End Sub

voici mon code ajout de lignes d'articles

Private Sub ajout_Click()
'*** bouton "ajout sur devis/facture"

  Dim lig As Integer, i As Integer
  Dim Sh As Worksheet, VPB As PageSetup
  Dim LargeurCol As Single, MaHauteur As Single, Lg_Origine As Single
  'calcul de la valeur de la variable lig
  Dim Mot As String
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False

  If Me.TBqtevente.Value = "" Then
  MsgBox "Entrer une quantité,svp"
  Exit Sub

  End If
 
  With wsFacture
    .Range("c18:M18,O18:P18").Borders(xlEdgeBottom).LineStyle = xlContinuous
'    lig = .Range("B65536").End(xlUp)(2).Row
    lig = .Range("B" & .Rows.Count).End(xlUp)(2).Row
    If lig < 19 Then lig = 19

    'insertion d'une ligne
    '.Rows(lig + 1).Insert
    .Range("C" & lig - 1 & ":P" & lig - 1).Copy
    .Range("C" & lig).Insert xlShiftDown
    .Range("C" & lig & ":P" & lig).ClearContents
    .Range("C" & lig & ":H" & lig).HorizontalAlignment = xlLeft
  
    If Not Me.TBarticles = "" Then
      .Rows(lig) = ""
      .Range("D" & lig) = TBarticles.Value
      Lg_Origine = .Columns(3).ColumnWidth
      LargeurCol = .Columns(3).ColumnWidth + .Columns(4).ColumnWidth + .Columns(5).ColumnWidth + .Columns(6).ColumnWidth + _
                   .Columns(7).ColumnWidth + .Columns(8).ColumnWidth
      .Columns(4).ColumnWidth = LargeurCol
      With .Range("D" & lig, "H" & lig)
        .Font.Size = 14
        .Font.Name = "arial"
        .MergeCells = False
        .WrapText = True  'retour du texte à la ligne
        .EntireRow.AutoFit  'mettre la ligne en ajustement auto de la hauteur
        MaHauteur = .RowHeight  'voir quelle est la hauteur de la ligne une fois cet autofit fait
        .MergeCells = True  'refusionner

        '.VerticalAlignment = xlCenter
        .RowHeight = IIF(MaHauteur > 15, MaHauteur, 15)  'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
      End With
    End If
    .Columns(4).ColumnWidth = Lg_Origine
    'recopie et mise en forme des données dans la feuille facturation
    .Cells(lig, "B") = Me.TBnum
    .Cells(lig, "D") = Me.TBarticles
    .Cells(lig, "D").Font.Bold = False
    '.Cells(lig, "D").HorizontalAlignment = xlLeft
    '.Cells(lig, "D").VerticalAlignment = xlCenter
    .Range("D" & lig & ":H" & lig).Merge
    .Cells(lig, "I") = Me.TBpu
    .Cells(lig, "I").NumberFormat = "#,##0.00 €"
    .Cells(lig, "J") = Me.TBunité
    .Cells(lig, "K") = Me.TBqtevente
    .Cells(lig, "M") = Abs(Me.OB20) + 1


    'calcul du montant HT
    If IsNumeric(.Cells(lig, "I")) And IsNumeric(.Cells(lig, "K")) Then
      .Cells(lig, "O").FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.10,"""")"
      .Cells(lig, "O").NumberFormat = "#,##0.00 €"
      .Cells(lig, "P").FormulaR1C1 = "=IF(RC[-3]=2,RC[-7]*RC[-5]*0.20,"""")"
      .Cells(lig, "P").NumberFormat = "#,##0.00 €"
      .Cells(lig, "L").FormulaR1C1 = "=RC[-1]*RC[-3]"
      .Cells(lig, "L").NumberFormat = "#,##0.00 €"
    End If
    'calcul du montant HT
    If IsNumeric(.Cells(lig, "I")) And IsNumeric(.Cells(lig, "K")) Then
       '.Cells(lig, "L") = "=" & .Cells(lig, "I").AddressLocal & "*" & .Cells(lig, "K").AddressLocal
        .Cells(lig, "L") = "=" & .Cells(lig, "I").Address(RowAbsolute:=False) & "*" & .Cells(lig, "K").Address(RowAbsolute:=False)
        Else
      .Cells(lig, "O") = ""
      .Cells(lig, "P") = ""
    End If
    'calcul des totaux montant HT, TVA10, TVA 20
    For i = lig To 1 Step -1
        If .Cells(i, "K") = "REPORT" Or .Cells(i, "K") = "Quantité" Then Exit For
    Next i
    .Cells(lig + 1, "L").Formula = "=SUM(" & .Range(.Cells(i + 1, "L"), .Cells(lig, "L")).Address(RowAbsolute:=False) & ")"
    .Cells(lig + 1, "L").NumberFormat = "#,##0.00 €"
    .Cells(lig + 1, "O").Formula = "=SUM(" & .Range(.Cells(i + 1, "O"), .Cells(lig, "O")).Address(RowAbsolute:=False) & ")"
    .Cells(lig + 1, "O").NumberFormat = "#,##0.00 €"
    .Cells(lig + 1, "P").Formula = "=SUM(" & .Range(.Cells(i + 1, "P"), .Cells(lig, "P")).Address(RowAbsolute:=False) & ")"
    .Cells(lig + 1, "P").NumberFormat = "#,##0.00 €"
  
    If .Cells(lig + 1, "P") < 0.0001 Then .Cells(lig + 1, "P") = ""
    If .Cells(lig + 1, "O") < 0.0001 Then .Cells(lig + 1, "O") = ""
  
    'Remise a zéro du formulaire
     TBnum.Value = ""
    TBarticles.Value = ""
    Me.TBtranche = ""
     TBpu.Value = ""
    TBqtevente.Value = ""
        TBunité.Value = ""
 

    'Formatage du tableau


    .Cells(lig, "C").Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range(.Cells(lig, "I"), .Cells(lig, "P")).Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range(.Cells(lig, "C"), .Cells(lig, "M")).Borders(xlEdgeTop).LineStyle = xlNone
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).Borders(xlEdgeTop).LineStyle = xlNone
    .Range(.Cells(lig, "C"), .Cells(lig, "M")).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range(.Cells(lig, "D"), .Cells(lig, "H")).Borders(xlInsideVertical).LineStyle = xlNone
    .Range(.Cells(lig, "I"), .Cells(lig, "Q")).Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).VerticalAlignment = xlCenter

    .Range(.Cells(lig, "I"), .Cells(lig, "M")).VerticalAlignment = xlCenter

    With .Range("C19:M" & lig & ",O19:P" & lig)
      .Font.Size = 14
      .Font.Name = "arial"
    End With
  End With
  wsFacture.Range("c19:M19").Borders(xlEdgeTop).LineStyle = xlContinuous
  wsFacture.Range("O19:P19").Borders(xlEdgeTop).LineStyle = xlContinuous

  ActiveWindow.ScrollRow = IIF((lig - NB_LIGNE_ARTICLE_FIGE) > Range("DOC_TITRE").Row, lig - NB_LIGNE_ARTICLE_FIGE, Range("DOC_TITRE").Row + 1)


  Application.ScreenUpdating = True
  Application.EnableEvents = True

End Sub

qui mets les formules adéquates a chaque ajout et permet un calcul du total des colonnes de prix et tva

 

[eriiic]

J'ai bien compris, c'est toi qui n'a pas compris ma réponse je pense

autant que tu prévois une dernière ligne supplémentaire toujours vide (et idem pour la 1ère à mon avis), dont tu peux réduire la hauteur.

Si la dernière ligne fait 3 pixels de haut et qu'elle est toujours vide tu n'auras plus à la couper pour la déplacer, la dernière donnée sera toujours au-dessus.
Donc 2 lignes haut et bas de qq pixels avec tes mises en forme particulières, et une ligne entre avec le format pour la 1ère ligne commande, les autres s'y insèrent également.
Tu n'auras plus à te soucier de refaire la mise en forme.

 

[grisan29]

bonsoir ériiic
si j'avais bien compris donc tu voudrais que je mette 1 lignes vide en haut et 1 en bas,
je suis en cours de le modifier et cela en fait partie, en haut peu etre plus facile qu'en bas je vais voir mais c'était pas le but de le faire comme cela sans etre sur que cela marche car il d'autres interactions avec les modules de classes

 

[grisan29]

je viens d'essayer pour une ligne haute et les bordures ne se mettent plus du coup
je crois que je vais rester avec le code comme il était avant et tapis pour l'évolution du classeur
je le sort de la listview qui est très bien mais a un défaut c'est ne pas avoir l'ocx adapter a chaque machine

 

[eriiic]

Et bien sinon redessine les encadrements, ce n'est que 2-3 lignes par bloc. Je suppose que tu connais le nombre de lignes de commande :

    Dim nblig As Long
    nblig = 17
    With Range("C18:H18").Resize(nblig)
        .Borders.LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    With Range("I18:M18").Resize(nblig)
        .Borders.LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    With Range("O18:P18").Resize(nblig)
        .Borders.LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With

eric

 

[grisan29]

bonjour eriiic
non je ne connais pas a l'avance le nombre ligne qu'il me faut, comme je l'ai dit cela peux aller de 2 a 200 comme plus ou moins je ne sais pas a l'avance, c'est le code d'impression qui gère la mise en page e le nombre de fauille

 

[eriiic]

Non, tu ne le sais pas à l'avance.
Mais si tu écris une ligne tu peux incrémenter le nombre dans une variable, plus 1 pour un titre de regroupement aussi.
Ca m'étonne qu'une telle variable n'existe pas déjà.

 

[grisan29]

bonjour eriiic
la procédure est dans le code ajout que j'ai mis plus haut dont voici l'estrait

'insertion d'une ligne
    '.Rows(lig + 1).Insert
    .Range("C" & lig - 1 & ":P" & lig - 1).Copy
    .Range("C" & lig).Insert xlShiftDown
    .Range("C" & lig & ":P" & lig).ClearContents
    .Range("C" & lig & ":H" & lig).HorizontalAlignment = xlLeft

 

[TooFatBoy]

Bonjour,

As-tu essayé de te baser sur la solution donnée ici : https://www.excel-downloads.com/threads/remonter-ligne-oui-mais-pas-la-bordure.20013229/ ?


Ainsi ta procédure de déplacement se résumerait à ceci :

Private Sub CommandButton1_Click()
    Rows(ActiveCell.Row).Cut
    Rows(Cb_ligne.Text + 1).Select
    Selection.Insert Shift:=xlDown
    Range("D" & (Cb_ligne.Text + 1)).Select 
    Call mise_a_jour_cb
End Sub

PS : est-ce volontaire que ta feuille aille jusqu'en FUT268 ???

 

[grisan29]

bonjour Marcel
non je ne peux faire comme tu le disais car je ne sais pas a l'avance le nombre de lignes a inscrire
de plus j'avais oublier ce post

bon les lignes que tu as proposé font exactement le pourquoi j'ai ouvert ses post

 

[TooFatBoy]

Je n'ai toujours pas compris ton histoire de connaître le nombre de lignes à l'avance.
Ca t'apporterait quoi ?

bon les lignes que tu as proposé font exactement le pourquoi j'ai ouvert ses post

Ben tu vois, ce n'était pas si compliqué, il suffisait d'essayer ce que je proposais.

 

[grisan29]

bonjour Marcel32
j'ai peut etre mal dit je que j'ai écrit, les lignes que tu as données font exactement la même chose que le code que j'ai donné
c'est a dire qu'elle envoi la bordure avec elle

 

[TooFatBoy]

Si ces lignes de code déplacent le trait du bas de ton tableau, c'est que tu n'as pas effectué les modifications que j'ai expliquées dans l'autre fil de discussion. L'un ne va pas sans l'autre.