Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Bordure automatique VBA

anass1

XLDnaute Junior
Bonjour
je voudrai définir une Bordure automatique aux cellules lors de l'exportation dans un autre classeur avec du code VBA
merci

Code:
With Application.Workbooks.Add
Application.Visible = True
Dim chosename
chosename = InputBox("Veuillez nommer la feuil:", "Nommer la nouvelle feuil")
'If chosename = "" Then Exit Sub
Sheets(1).Name = chosename & " ;" & Format(Now(), "dd-mm-yyyy")
temp.Range("z1:ah1").Copy Sheets(1).Range("a1:I1")
Sheets(1).Range("a1:I1").ColumnWidth = 14
Dim lastrow
lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
For v = 0 To Me.ListBox1.ListCount - 1
Cells(lastrow, 1).Value = Me.ListBox1.List(v, 0)
Cells(lastrow, 2).Value = Me.ListBox1.List(v, 1)
Cells(lastrow, 3).Value = Me.ListBox1.List(v, 2)
Cells(lastrow, 4).Value = Me.ListBox1.List(v, 3)
Cells(lastrow, 5).Value = Me.ListBox1.List(v, 4)
Cells(lastrow, 6).Value = Me.ListBox1.List(v, 5)
Cells(lastrow, 7).Value = Me.ListBox1.List(v, 6)
Cells(lastrow, 8).Value = Me.ListBox1.List(v, 7)
lastrow = lastrow + 1
Next
MsgBox "Export réalisé avec succès"
End With
 

Pièces jointes

  • export.xlsm
    58.6 KB · Affichages: 24

vmax01

XLDnaute Occasionnel
bonjour anass1, le forum,

je te repasse ton code avec la modification.
Code:
Private Sub CommandButton3_Click()
With Application.Workbooks.Add
Application.Visible = True
Dim chosename
chosename = InputBox("Veuillez nommer la feuil:", "Nommer la nouvelle feuil")
'If chosename = "" Then Exit Sub
Sheets(1).Name = chosename & " ;" & Format(Now(), "dd-mm-yyyy")
temp.Range("z1:ah1").Copy Sheets(1).Range("a1:I1")
Sheets(1).Range("a1:I1").ColumnWidth = 14
Dim lastrow
lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
For v = 0 To Me.ListBox1.ListCount - 1
    Cells(lastrow, 1).Value = Me.ListBox1.List(v, 0)
    Cells(lastrow, 3).Value = Me.ListBox1.List(v, 2)
    Cells(lastrow, 4).Value = Me.ListBox1.List(v, 3)
    Cells(lastrow, 5).Value = Me.ListBox1.List(v, 4)
    Cells(lastrow, 6).Value = Me.ListBox1.List(v, 5)
    Cells(lastrow, 7).Value = Me.ListBox1.List(v, 6)
    Cells(lastrow, 8).Value = Me.ListBox1.List(v, 7)
    With Range(Cells(lastrow, 1), Cells(lastrow, 8))
        .Borders.LineStyle = xlContinuous
    End With
    lastrow = lastrow + 1
Next
MsgBox "Export réalisé avec succès"
End With
End Sub

bonne journée
 

Discussions similaires

Réponses
4
Affichages
419
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…