Bonjour,

Je développe une petite macro qui automatise la création d'un tableau, au fur et à mesure que j'ajoute des lignes ;

J'ai un optional a (boolean) qui automatique la creation de l'en tête,

Le tout part d'une cellule (haut à gauche).

Voici le code :
Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub CadreWS(c As Range, ws As Worksheet, Optional a As Boolean): Application.ScreenUpdating = False
 
'########################################################
' Cree une tableau automatique
' (borders)
' si a <> nothing la premiere ligne prend le format de c
' NB : peut être mieux avec CurrentRegion
'########################################################
 
Dim lig As Integer
Dim col As Integer
 
Dim rTete As Range  'en tete du tableau
Dim rg As Range     ' range tableau
Dim rg2 As Range    ' range un peu plus grand que le tableau (pour effacement bordures)
Dim lig2 As Integer ' lignes de rg2
Dim col2 As Integer ' col de rg2
 
 
' PART 1 - CURRENTREGION
 
'affectation range de travail
Set rg = c.CurrentRegion
 
'dim du futur tableau
lig = rg.Rows.Count
col = rg.Columns.Count
 
 
' condition d'exit pour si on n'a qu'une ligne
If lig = 1 Then Exit Sub
 
'dim +1 du futur tableau (pour effacement bordures)
lig2 = lig + 1
col2 = col + 1
 
'affectation tableau + 1
Set rg2 = rg.Resize(lig2, col2) ': Debug.Print "Adresse de rg2 : " & rg2.Address(False, False)
 
' PART 2 - GESTION BORDURES
 
With ws
    'condition sortie si juste c en entete (en fait deja verifie avant)
    'If col2 = .Columns.Count + 1 Then Exit Sub
 
    'effacement bordures precedentes
    rg2.Borders.LineStyle = xlLineStyleNone
 
    'mise en forme bordures
    With rg.Borders
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
 
' PART 3 - COLOR ENTETE
    If a = True Then
        Set rTete = rg.Resize(1, col) ': Debug.Print "Adresse de rTete : " & rTete.Address(False, False)
        c.Copy (rTete.PasteSpecial(xlPasteFormats))
 
        Application.CutCopyMode = False
    End If
End With
Application.ScreenUpdating = True
End Sub

Je cherche à faire exactement ceci
J'ai pris l'habitude de faire les CTRL + ALT + V, à la mano ça marche très bien pour choisir "FORMAT".
Mais en VBA, ça semble plus compliqué,
mon code ne fonctionne pas, cela pêche (ou poire !) à cette partie :

Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
PART 3 - COLOR ENTETE
    If a = True Then
        Set rTete = rg.Resize(1, col) ': Debug.Print "Adresse de rTete : " & rTete.Address(False, False)
        c.Copy (rTete.PasteSpecial(xlPasteFormats))
 
        Application.CutCopyMode = False
    End If

Je suis tombé sur de nombreux sujets, par exemple celui-ci BTC ALDOUS.xlsm

J'ai essayé avec plusieurs façons de faire, jusqu'à présent ça n'a rien donné !

N'hésitez pas si vous avez des pistes,

Zoubi la team !