Discussion :

[thespeedy20]

Bonjour le Forum, Bonjour à tous


J'ai un petit soucis avec ma boucle avec les cellules vide...
Je dois imprimer les diplômes uniquement ceux avec des points... mais ici ils me créent quand même des diplômes qui n'ont pas de point...

Pouvez-vous m'aider sur mon petit problème

Merci d'avance...


Oli

[Qwazerty]

Salut

Hum, je dirais surtout qu'il est urgent de regarder du coté du publipostage et ainsi ne pas réinventer la roue

++
Qwaz

[thespeedy20]

re,

Bonsoir,

Merci pour le conseil... mais j'ai envie de terminer ce projet sous excel... une petite aide quand même ?

Vous remerciant par avance

Oli

[Qwazerty]

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
79
80
81
82
'Oblige a déclarer toutes la variable (du coup une alerte si on à fait une faute de frappe dans le nom d'une variable)
Option Explicit
 
Sub Lancement_macrodiplom()
Call Certificat
Call Transfertdiplo
End Sub
 
Sub Transfertdiplo()
 
  Dim CelSource As Range
  Dim CelCible As Range
  Dim Compteur As Integer
  Dim NBlignes As Integer
  Dim a As Integer
  Dim b As Integer
  Dim c As Integer
 
    'Début à la cellule A2 pas A4 je pense
    Set CelSource = Worksheets("Résultat").Range("a2")
    Set CelCible = Worksheets("Diplomes").Range("a19")
 
    NBlignes = Application.CountA(Sheets("Résultat").Range("A:A")) - 1
 
    Application.ScreenUpdating = False
    Worksheets("Résultat").Activate
 
    'L'utilisation de ActiveSheet peut jouer de vilain tour, autant utiliser le codename de la feuille
    With Feuil3 'ActiveSheet
        'x = NBlignes *41
        For c = 0 To NBlignes - 1
            If Not IsEmpty(CelSource.Offset(c, 8).Value) Then
                For a = 1 To NBlignes Step 41
                    '??
                    'For Compteur = 1 To 1
                        ' les pages
                        CelCible(a, 1).Value = CelSource.Offset(c, 9).Value
                        CelCible(a + 6, 1).Value = CelSource.Offset(c, 2).Value
                        CelCible(a + 11, 1).Value = CelSource.Offset(c).Value
                        CelCible(a + 14, 1).Value = VBA.Format((CelSource.Offset(c, 8).Value), """Avec: ""0.00%")
                        Set CelSource = CelSource.Offset(1)
                        Set CelCible = CelCible.Offset(42)
                    'Next
                Next
            End If
        Next
    End With
End Sub
 
Sub Certificat()
Dim SHsource As Worksheet, SHcible As Worksheet, x As Integer
Dim PlageSource As Range, CelluleCible As Range, I As Integer
Dim NBlignes As Integer
 
    Set SHsource = ThisWorkbook.Sheets("Certificat") '<-- classeur source
    Set SHcible = ThisWorkbook.Sheets("Diplomes") '<-- classeur cible
    Set PlageSource = SHsource.Range("A1:A42") '<-- plage de cellules à copier
 
    NBlignes = Application.CountA(Sheets("Résultat").Range("I:I")) - 1
    Z = NBlignes * 42
 
    For j = 1 To Z Step 42
        Set CelluleCible = SHcible.Cells(j, 1) '<-- destination (à partir de F11)
        PlageSource.Copy CelluleCible '<-- copie de la plage
        'adaptation hauteur des lignes
        x = 0
        For I = CelluleCible.Row To CelluleCible.Row + PlageSource.Rows.Count
            x = x + 1
           SHcible.Cells(I, 1).RowHeight = PlageSource.Rows(x).RowHeight
        Next
 
        'adaptation largeur des colonnes
        PlageSource.Resize(, PlageSource.Columns.Count).Copy
        SHcible.Cells(1, CelluleCible.Column).Resize(, PlageSource.Columns.Count).PasteSpecial xlPasteColumnWidths
 
'        x = 0
'        For I = CelluleCible.Column To CelluleCible.Column + PlageSource.Columns.Count
'           x = x + 1
'           SHcible.Cells(1, I).ColumnWidth = PlageSource.Columns(x).ColumnWidth
'        Next
    Next j
End Sub

++
Qwaz

[Qwazerty]

Salut

Sinon, en utilisant un tableau structuré pour limité le travail de recherche des données.
En adaptant un peu le certificat modèle.

++
Qwaz

[thespeedy20]

Bonjour Qwazerty,

Merci pour cette version qui fonctionne très bien...

Une petite question le tableau peut-être variable, il y a moyen qu'il puisse s'adapter automatiquement ? (tab_résultat)

j 'ai un deuxième modèle de certificat (2 sur une même page) voir fichier, on peut utiliser la même macro, ou faut il adapter avec un step ....

Encore merci pour ta rapidité et le temps consacré

Oli

[Pierre Fauconnier]

Salut.

Il me semble qu'un publipostage dans Word serait bien plus efficace et permettrait de se passer de VBA.

[EDIT] Oups, désolé Qwaz, je n'avais pas vu ta première intervention... Je laisse tout de même la mienne pour bien enfoncer le clou...

[Qwazerty]

Salut

@Pierre : Pourvu que ça dur Mais rassure toi, je dis encore beaucoup de bêtises, donc tu auras probablement l'occasion de me reprendre

++
Qwaz

[Pierre Fauconnier]

je dis encore beaucoup de bêtises[...]

Pas souvenir d'avoir vu des "bêtises" de l'ami Qwaz (peut-être parfois des choses que j'aurais réalisées autrement, mais des bêtises, jamais...)

[thespeedy20]

Bonjour le forum,

@pierre, l idée est intéressante... Mais j avais commencé en Excel et je voulais absolument finir ce projet...

@patrick, as tu vu mon dernier message... Au niveau des doubles certificats...

Merci


Bonne journée à tous....