ou encore (justifié si impressions fréquentes d'étiquettes) :
Utiliser l'objet Printer
Se faire une routine paramétrée .
Paramètres : nb étiquettes en hauteur, en largeur, espaces entre les étiquettes en hauteur et en largeur, nombre de lignes par étiquette, police, etc ... et le recordset à traiter.
C'est ce que j'avais fait (une fois pour toutes) lorsque j'étais en activité. Marchait fort bien et n'était pas gourmand en ressources.
C'est du boulot, c'est sûr, mais fait une fois pour toutes et tous les cas de figure.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
en fait mon datareport est déja fait, il représente une étiquette composée de plusieurs champs, mais lorsque j'édite mon datareport (exemple 30 étiquettes), les étiquettes sortent les unes au dessous des autres (8 sur la hauteur d'une feuille) et la 9ième est imprimée sur une nouvelle page avec la 10 11 12 13 14 15 et 16ième...
ce que je cherche à faire c'est que la deuxième ce mette à coté de la première, la troisième également et que la 4ième se positionne sous la 1ière, la cinquième sous la deuxième...
ce que j'ai :
______________________
| 1ière |
|____________________|
| 2ième |
|____________________|
| 3ième |
|____________________|
ce que je veux :
__________________________________________________________________
| 1ière || 2ième || 3ième |
|____________________||____________________||____________________|
| 4ière || 5ième || 6ième |
|____________________||____________________||____________________|
| 7ière || 8ième || 9ième |
|____________________||____________________||____________________|
Si tu veux te faciliter la vue :
intéresse-toi de très près aux fonctions suivantes de la librairie User32 de l'Api de Windows :
DrawText Lib
SetRect
OffsetRect
De mémoire, ce sont elles que j'avais utilisées pour leur parfaite souplesse.
Etudie-les avec le plus grand soin. Tu devrais en tirer profit car les "rectangles d'accueil" sont parfaitement paramétrables.
Un indice (toujours de mémoire) : la fonction OffsetRect réagit parfaitement aux valeurs négatives
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Bon ...
J'ai tout de même quelque peu conscience de ce que tout cela, sans un début, peut te paraître assez broussailleux.
Je t'ai fait donc un petit "machin" qui devrait te mettre sur la voie.
Tout le reste ne sera qu'arithmétique pure :
Sur un Form : un bouton de commande et une picturebox etr ce code
Const DC_ACTIVE = &H1
Const DC_NOTACTIVE = &H2
Const DC_ICON = &H4
Const DC_TEXT = &H8
Const BDR_SUNKENOUTER = &H2
Const BDR_RAISEDINNER = &H4
Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Const BF_BOTTOM = &H8
Const BF_LEFT = &H1
Const BF_RIGHT = &H4
Const BF_TOP = &H2
Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Const DFC_BUTTON = 4
Const DFC_POPUPMENU = 5 'Only Win98/2000 !!
Const DFCS_BUTTON3STATE = &H10
Const DT_CENTER = &H1
Const DC_GRADIENT = &H20 'Only Win98/2000 !!
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Sub Command1_Click()
Dim R As RECT, texte As String, ecarth As Integer, ecartv As Integer, largeur As Integer, hauteur As Integer
ecarth = 10
largeur = 140
hauteur = 70
ecartv = 10
Picture1.Cls
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.Move 0, 0, 460, 280
SetRect R, 0, 0, largeur, hauteur
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
DrawText Picture1.hdc, texte, Len(texte), R, DT_CENTER
plush = plush + largeur + ecarth
OffsetRect R, largeur + ecarth, 0
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
DrawText Picture1.hdc, texte & Chr(10) & "&&&&", Len(texte), R, DT_CENTER
plush = plush + largeur + ecarth
OffsetRect R, largeur + ecarth, 0
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
DrawText Picture1.hdc, texte & Chr(10) & "&&&&", Len(texte), R, DT_CENTER
OffsetRect R, -plush, hauteur + ecartv
plush = 0
DrawText Picture1.hdc, texte, Len(texte), R, DT_CENTER
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
DrawText Picture1.hdc, texte & Chr(10) & "&&&&", Len(texte), R, DT_CENTER
plush = plush + largeur + ecarth
OffsetRect R, largeur + ecarth, 0
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
DrawText Picture1.hdc, texte & Chr(10) & "&&&&", Len(texte), R, DT_CENTER
plush = plush + largeur + ecarth
OffsetRect R, largeur + ecarth, 0
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
DrawText Picture1.hdc, texte & Chr(10) & "&&&&", Len(texte), R, DT_CENTER
End Sub
Lance, clique === regarde (tu vas commencer à comprendre).
Je t'ai fait deux lignes (pour te montrer le type de calcul à faire)
A toi de continuer
Une précision : l'objet Printer réagit très exactement comme une picturebox. Tu n'as donc pas de papier à gaspiller lors de tes essais. Entraîne-toi d'abord avec une picturebox
Une promesse : si tu te sens perdu en chemin ici où là, appelle au secours (je viendrai, promis). Mais ne le fais qu'après avoir toi-même bataollé (donnant donnant, comme toujours).
Allez ===>> jette-toi dans le bain.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Ah oui (bien sûr) : mets à true la propriété autoredraw de la picturebox
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Où en es-tu, sandrine01 ?
Pour ton info (et pour que tu te sentes moins seul) :
Je suis en train de recommencer méthodiquement ce que j'avais à l'époque déjà fait (il y a bientôt 16 ans ...)
J'ai déjà terminé la partie essentielle ===>> la répartition paramétrée des étiquettes.
Il ne me reste qu'à peaufiner (comme je l'avais également fait à l'époque) pour, en fonction du nombre de caractères de la ligne la plus longue, choisir automatiquement la taille idéale (pour une police déterminée) de caractères.
Ce sera tout un outil .
Lorsque terminé : j'en déposerai le code source/démo.
Mais j'aimerais bien voir où toi, tu en es ...
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Bon...
Je vais t'aider à passer à une seconde étape.
Regarde ce que fait ceci :
Const DT_CENTER = &H1
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private nolig As Long
Private Type etiquettes ' ===>> définition d'une page d'étiquettes
nbx As Integer '===>> nombre d'étiquettes en largeur
nby As Integer '===>> nombre d'étiquettes en hauteur
largeur As Integer '===>> largeur de chaque étiquette
hauteur As Integer '===>> hauteur de chaque étiquette
ecartx As Integer ' ===>> écart horizontal entre deux étiquettes
ecarty As Integer ' ===>> écart vertical entre deux étiquettes
margehaute As Integer ' ==>> marge haute (entre le bord supérieur de la feuille et celui de la 1ère étiquette)
margegauche As Integer ' ==>> marge gauche (entre le bord gauche de la feuille et celui de la 1ère étiquette)
End Type
Private mes_etiquettes As etiquettes
Private R As RECT
Private Sub Command1_Click()
With mes_etiquettes
' c'est en millimètres, règle en mains, que l'on relève les différentes mesures
.nbx = 3 '=====>>donc : nombre d'étiquettes en largeur
.nby = 8 '===>> donc : nombre d'étiquettes en hauteur
.largeur = 45 '===>> donc : largeur de chaque étiquette
.hauteur = 20 '===>> donc : hauteur de chaque étiquette
.ecartx 2 '>> donc : écart horizontal entre deux étiquettes
.ecarty 2 '>> donc : écart vertical entre deux étiquettes
.margehaute 5 '>> donc : marge haute (entre le bord supérieur de la feuille et celui de la 1ère étiquette)
.margegauche 4 '>> donc : marge gauche (entre le bord gauche de la feuille et celui de la 1ère étiquette)
End With
With mes_etiquettes
'c'est en pixels, que l'on va travailler ===>>> on concertit donc
.largeur = ScaleX(.largeur, vbMillimeters, vbPixels)
.hauteur = ScaleY(.hauteur, vbMillimeters, vbPixels)
.ecartx = ScaleX(.ecartx, vbMillimeters, vbPixels)
.ecarty = ScaleY(.ecarty, vbMillimeters, vbPixels)
.margehaute = ScaleY(.margehaute, vbMillimeters, vbPixels)
.margegauche = ScaleX(.margehaute, vbMillimeters, vbPixels)
End With
'simulation
' on va simuler l'exploitation d'un recordset en se contentant d'envoyer, à chaque fois, des données
' par une boucle for ... to ... au lieu de données (un champ nom, un champ adresse1, un champ adresse2 et un champ ville)
' que l'on obtiendrait par un Movenext
Dim texte As String
nolig = 0
For i = 1 To 140
' on simule l'extraction des champs du recordset
nom = "nom " & i
adresse1 = "voila la première ligne d'adresse" & i
adresse2 = "voila la première ligne d'adresse" & i
ville = "ville" & i
' on "construit le texte de l'étiquette pour cet article ainsi simulé
texte = "M. machin Pierre" & vbCrLf & "22, av chépaoù" & vbCrLf & "TATAOUINE"
texte = nom & vbCrLf & adresse1 & vbCrLf & adresse2 & vbCrLf & ville
' et on l'envoie à la routine etiq
etiq texte
Next
End Sub
Private Sub etiq(texte As String)
'il n'y a là que de l'arithmétique. Rien d'intéressant en soi, mais tout insdispensable
sautv = mes_etiquettes.hauteur + mes_etiquettes.ecarty
If nolig = 0 Then Picture1.Cls
If nolig Mod mes_etiquettes.nbx 0 Then '>> si on arrive en bout de ligne ===>> on revient en arrière
g = -mes_etiquettes.largeur + mes_etiquettes.margegauche
h = ((nolig \ mes_etiquettes.nbx) * sautv) + mes_etiquettes.margehaute
d = g + mes_etiquettes.largeur
b = h + mes_etiquettes.hauteur
SetRect R, -mes_etiquettes.largeur, h, d, b '===>> on place notre rectangle "à l'affut" du prochain déplacement
End If
nolig nolig + 1 '>> on avance d'une étiquette
OffsetRect R, mes_etiquettes.largeur + mes_etiquettes.ecarty, 0 '===>> on déplace notre rectangle
DrawText Picture1.hdc, texte, Len(texte), R, DT_CENTER ' ===>> on y écrit
If nolig Mod (mes_etiquettes.nbx * mes_etiquettes.nby) = 0 Then '===>> c'est donc qu'on a fini une planche d'étiquettes
MsgBox "on a fait une page" & vbCrLf & "simulons la suivante"
Picture1.Cls
nolig = 0
End If
DoEvents
End Sub
Private Sub Form_Activate()
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.Move 0, 0, 600, 1600
End Sub
Lis tout (surtout mes commentaires) avant d'exécuter.
Cela commence à prendre forme, non ?
Ce n'est là que la seconde étape, toutefois. Les autres vont suivre.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Je m'absente après-demain pour environ une semaine et ai voulu te faire un petit cadeau avant mon départ.
Tu le trouveras là ===>> Tapez le texte de l'url ici. J'espère qu'il te plaira.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
