Discussion :

[gibba88]

bonjour je suis débutant en VBA ,et je voudrais faire une procédure ou fonction AFFICHAGE qui me qui me permetrait de répéter 6 fois (3 en haut et 3 en dessous) dans la méme feuille excel une en_tête de 4 éléments (NOM ,Prénom,AGE,Nationalité) et un bordure qui varie en fonction des sous élemnts que composent ces en têtes. Merci d'avance pour votre soutient

[Paritec]

Bonjour Gibba 88 le forum
un peu light tes explications, c'est quoi ton histoire de bordures différentes??
de plus la série Nom Prenom age nationalité tu veux les mettre comment?
A1B1C1D1 et là suivante E1 F1 G1 H1 mais la suivante de série tu la veut ou??
a te relire
a+
papou

[gibba88]

oui papou c'est a peu prés ca A4B4C4D4---G4H4I4J4---M4N4O4P4; A24B24C24D24---G24H24I24J24---M24N24O24P24, Mercie d'avance

enfaite j'ai pris "Nom,Pronom,Age...." pour ne pas trop vous embrouiller avec mon programme .mais voila mon vrai procédure affichage .mais j'aimeriais le simplifié en un code simple de sorte à ne pas réecrire 6 fois l'en tête dans la méme procédure

Code :

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
'Proprietés
Sub Affichage_Entête()
'sélection de la feuille d'affection
Sheets("feuil1").Select
'propreté Police
Range("a4:F4").Font.Bold = True
Range("a4:F4").Font.Size = 13
Range("a4:F4").Borders.Value = 0
'propreté Police
Range("H4:M4").Font.Bold = True
Range("H4:M4").Font.Size = 13
Range("H4:M4").Borders.Value = 0
'propreté Police
Range("O4:T4").Font.Bold = True
Range("O4:T4").Font.Size = 13
Range("O4:T4").Borders.Value = 0
'propreté Police
Range("a24:F24").Font.Bold = True
Range("a24:F24").Font.Size = 13
Range("a24:F24").Borders.Value = 0
'propreté Police
Range("H24:M24").Font.Bold = True
Range("H24:M24").Font.Size = 13
Range("H24:M24").Borders.Value = 0
'propreté Police
Range("O24:T24").Font.Bold = True
Range("O24:T24").Font.Size = 13
Range("O24:T24").Borders.Value = 0
 
 
With ActiveSheet
    .Cells(3, 1) = "DEFAUT PHASE"
    .Cells(3, 7) = "DEFAUT HOMOPOLAIRE"
    .Cells(3, 13) = "CYCLE REENCLENCHEUR"
    .Cells(23, 1) = "DEFAUT DOUBLE"
    .Cells(23, 7) = "TEST GRADIN"
    .Cells(23, 13) = "RSE"
End With
'en-tête
With ActiveSheet
    .Cells(4, 1) = "Nom"
    .Cells(4, 2) = "Nominale"
    .Cells(4, 3) = "Unités"
    .Cells(4, 4) = "Réel"
    .Cells(4, 5) = "Eval"
 
    .Cells(4, 7) = "Nom"
    .Cells(4, 8) = "Nominale"
    .Cells(4, 9) = "Unités"
    .Cells(4, 10) = "Réel"
    .Cells(4, 11) = "Eval"
 
    .Cells(4, 13) = "Nom"
    .Cells(4, 14) = "Nominale"
    .Cells(4, 15) = "Unités"
    .Cells(4, 16) = "Réel"
    .Cells(4, 17) = "Eval"
 
    .Cells(24, 1) = "Nom"
    .Cells(24, 2) = "Nominale"
    .Cells(24, 3) = "Unités"
    .Cells(24, 4) = "Réel"
    .Cells(24, 5) = "Eval"
 
    .Cells(24, 7) = "Nom"
    .Cells(24, 8) = "Nominale"
    .Cells(24, 9) = "Unités"
    .Cells(24, 10) = "Réel"
    .Cells(24, 11) = "Eval"
 
    .Cells(24, 13) = "Nom"
    .Cells(24, 14) = "Nominale"
    .Cells(24, 15) = "Unités"
    .Cells(24, 16) = "Réel"
    .Cells(24, 17) = "Eval"
End With
End Sub

[Philippe Tulliez]

Bonjour,
Une idée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 Dim r As Long
 With ActiveSheet
  For r = 1 To 200 Step 6
    .Cells(4, r) = "Nom"
    .Cells(4, r + 1) = "Nominale"
    .Cells(4, r + 2) = "Unités"
    .Cells(4, r + 3) = "Réel"
    .Cells(4, r + 4) = "Eval"
  Next
 End With

[Paritec]

Bonjour Gibba88 le forum
voilà une macro pour faire ce que tu demandes
a+
papou

Code :

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
Sub Composer()
    Dim i&, a As Variant, n&, x&
    With Feuil1
        For i = 3 To 24 Step 20
            For Each a In Array("Nom", "Nominale", "Unités", "Réels", "Eval")
                For n = 1 To 16 Step 6
                    .Cells(i + 1, n + x) = a
                    Next n
                x = x + 1
            Next a
            x = 0
        Next i
        .Cells(3, 1) = "DEFAUT PHASE": .Range(.Cells(3, 1), .Cells(3, 5)).Merge: .Range(.Cells(3, 1), .Cells(3, 5)).HorizontalAlignment = xlCenter
        .Cells(3, 7) = "DEFAUT HOMOPOLAIRE": .Range(.Cells(3, 7), .Cells(3, 11)).Merge: .Range(.Cells(3, 7), .Cells(3, 11)).HorizontalAlignment = xlCenter
        .Cells(3, 13) = "CYCLE REENCLENCHEUR": .Range(.Cells(3, 13), .Cells(3, 17)).Merge: .Range(.Cells(3, 13), .Cells(3, 17)).HorizontalAlignment = xlCenter
        .Cells(23, 1) = "DEFAUT DOUBLE": .Range(.Cells(23, 1), .Cells(23, 5)).Merge: .Range(.Cells(23, 1), .Cells(23, 5)).HorizontalAlignment = xlCenter
        .Cells(23, 7) = "TEST GRADIN": .Range(.Cells(23, 7), .Cells(23, 11)).Merge: .Range(.Cells(23, 7), .Cells(23, 11)).HorizontalAlignment = xlCenter
        .Cells(23, 13) = "RSE": .Range(.Cells(23, 13), .Cells(23, 17)).Merge: .Range(.Cells(23, 13), .Cells(23, 17)).HorizontalAlignment = xlCenter
        End With
End Sub

[mercatog]

Autre proposition

Code :

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
Sub ComposerBis()
Dim i As Integer, j As Integer
Dim Titre, Entete
Dim k As Byte
 
Entete = Array("Nom", "Nominale", "Unités", "Réels", "Eval")
Titre = Array("DEFAUT PHASE", "DEFAUT HOMOPOLAIRE", "CYCLE REENCLENCHEUR", "DEFAUT DOUBLE", "TEST GRADIN", "RSE")
With Feuil2
    For i = 3 To 24 Step 20
        For j = 1 To 16 Step 6
            With .Cells(i, j)
                .Resize(1, 5).Merge
                .Value = Titre(k)
                .Offset(1, 0).Resize(1, 5) = Entete
                With .Resize(2, 5)
                    .HorizontalAlignment = xlCenter
                    .Borders.Value = 0
                    With .Font
                        .Bold = True
                        .Size = 13
                    End With
                End With
            End With
            k = k + 1
        Next j
    Next i
End With
End Sub