Autres Déplacer la ligne vers la zone de liste et la feuille

[francescofrancesco]

Bonjour,
Dans le fichier ci-joint, comment puis-je déplacer la ligne sur la feuille sans déplacer la formule dans la colonne G.

'-----déplacer la ligne vers la feuill-------
For  jj = 1 a 7
tt = f.Cells(A + 2, jj)
f.Cells(A + 2, dd) = f.Cells(A + 1, dd)
f.Cells(A + 1, jj) = tt
Next  jj
[/CODICE]

 

[job75]

Bonsoir francescofrancesco,

Voyez le fichier joint et le code de l'UserForm :

Dim tablo As Range, mem 'mémorise les variables

Private Sub UserForm_Initialize()
Set tablo = Sheets("Data").[A1].CurrentRegion.Resize(, 4)
mem = tablo.Columns(7).Formula
ListBox1.List = tablo.Value
End Sub

Private Sub CommandButton1_Click()
Dim i
i = ListBox1.ListIndex
If i = -1 Then Exit Sub
If i < 2 Or i = ListBox1.ListCount - 1 Then MsgBox "questa riga non si puo' spostare": Exit Sub
tablo.Rows(i + 1).Cut
tablo.Rows(i + 3).Insert xlDown
ListBox1.List = tablo.Value
ListBox1.ListIndex = i + 1
tablo.Columns(7) = mem 'restitue les formules
End Sub

Private Sub CommandButton2_Click()
Dim i
i = ListBox1.ListIndex
If i = -1 Then Exit Sub
If i < 3 Then MsgBox "questa riga non si puo' spostare": Exit Sub
tablo.Rows(i + 1).Cut
tablo.Rows(i).Insert xlDown
ListBox1.List = tablo.Value
ListBox1.ListIndex = i - 1
tablo.Columns(7) = mem 'restitue les formules
End Sub

A+

 

[job75]

Bonjour le forum,

Avec cette solution il y a continuité, on passe d'une extrémité à l'autre :

Dim tablo As Range, mem, imax, i 'mémorise les variables

Private Sub UserForm_Initialize()
Set tablo = Sheets("Data").[A1].CurrentRegion.Resize(, 4)
mem = tablo.Columns(7).Formula
ListBox1.List = tablo.Value
imax = ListBox1.ListCount - 1 '13
End Sub

Private Sub CommandButton1_Click()
i = ListBox1.ListIndex
If i = -1 Then Exit Sub
If i < 2 Then MsgBox "questa riga non si puo' spostare": Exit Sub
tablo.Rows(i + 1).Cut
tablo.Rows(IIf(i = imax, 3, i + 3)).Insert xlDown
If i = imax - 1 Then Set tablo = tablo.Resize(imax + 1) 'redimensionnement nécessaire
ListBox1.List = tablo.Value
ListBox1.ListIndex = IIf(i = imax, 2, i + 1)
tablo.Columns(7) = mem 'restitue les formules
End Sub

Private Sub CommandButton2_Click()
i = ListBox1.ListIndex
If i = -1 Then Exit Sub
If i < 2 Then MsgBox "questa riga non si puo' spostare": Exit Sub
tablo.Rows(i + 1).Cut
tablo.Rows(IIf(i = 2, imax + 2, i)).Insert xlDown
If i = 2 Then Set tablo = tablo.Resize(imax + 1) 'redimensionnement nécessaire
ListBox1.List = tablo.Value
ListBox1.ListIndex = IIf(i = 2, imax, i - 1)
tablo.Columns(7) = mem 'restitue les formules
End Sub

A+

 

[francescofrancesco]

Bonjour,
super.
Je n'arrive pas à adapter votre code et, dans le fichier d'origine, je dois formater les colonnes de la listbox.

Private Sub UserForm_Initialize()
Dim arr
Set f = ThisWorkbook.Worksheets("primanota")

With f
arr = f.Range("A2:G" & f.[A65000].End(xlUp).Row).Value
End With

For L = LBound(arr) To UBound(arr)
        arr(L, 5) = Space(10 - Len(Format(arr(L, 5), "#,##0.00"))) & Format(arr(L, 5), "#,##0.00")
        arr(L, 6) = Space(10 - Len(Format(arr(L, 6), "#,##0.00"))) & Format(arr(L, 6), "#,##0.00")
        arr(L, 7) = Space(13 - Len(Format(arr(L, 7), "#,##0.00"))) & Format(arr(L, 7), "#,##0.00")
      
Next

With UserForm33.ListBox3
.List = arr
.ColumnCount = 7
.ColumnWidths = "30; 50; 60; 200; 60; 60; 70"
End With

End Sub

 

[job75]

Je n'arrive pas à adapter votre code et, dans le fichier d'origine, je dois formater les colonnes de la listbox.

Je ne vois pas ce que vous voulez adapter, quant au formatage c'est hors sujet.

 

[francescofrancesco]

Je ne vois pas ce que vous voulez adapter, quant au formatage c'est hors sujet.

C'est vrai.
Mais en faisant varier ce code pour charger la liste déroulante, vous pouvez formater les colonnes.

Set tablo = Sheets("Data").[A1].CurrentRegion.Resize(, 4)

 

[job75]

Bonjour francescofrancesco,

Bon d'accord pour formater la ListBox il suffit d'utiliser cette macro :

Sub Liste()
Dim a, i, j, x
a = tablo 'matrice, plus rapide
For i = 2 To UBound(a)
    For j = 2 To 3
        x = Format(a(i, j), "#,##0.00")
        a(i, j) = Space(10 - Len(x)) & x
Next j, i
ListBox1.List = a
End Sub

et de l'appeler dans les 3 autres macros.

La police de la ListBox est la police à chasse fixe Consolas.

A+