otobox Maison fondée en 2005 | Voilà un exemple qui correspond à ce que je décris dans mon message ci-dessus :
http://jiem51.perso.neuf.fr/prive/ [...] alette.zip Fichier zip de 238 Ko (244 042 octets) contenant :
- BDD.xls -> La liste des données
- Fiche palette.xls -> Le fichier excel contenant la macro et le template de l'étiquette.
- incrémentation et impréssion automatique [VBA excel] - VB_VBA_VBS - Programmation - FORUM HardWare.fr.pdf -> Ce fil de message
Le code des macros du fichier Fiche palette.xls :
Code :
- Option Explicit
- '************************************************************************
- '** Ces macros permettent d'imprimer automatiquement des étiquettes **
- '** renseignées à partir d'une données contenues dans un fichier Excel **
- '** extérieur. **
- '** Elle ne permet pas le choix de l'imprimante (qui est celle choisie **
- '** dans le gestionnaire d'imprimante). **
- '** **
- '** Ecrites & testées sous Excel 2003, Win XP, 32bits. **
- '** **
- '** Modifications, améliorations, redistribution fortement encouragées **
- '** **
- '** **
- '** OtObOx - 10/09/2011 **
- '************************************************************************
- 'Ouvre un explorateur pour sélectionner un fichier Excel
- 'et lance l'impression
- Sub ChoixFichier()
- Dim strReponse
- strReponse = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls", , "Sélectionner le fichier à imprimer" )
- If strReponse = False Then
- Cells(1, 1) = ""
- Else
- Cells(1, 1) = strReponse
- ImprimerFichesPalette
- End If
- End Sub
- 'Lance l'impression sans choisir le fichier à traiter
- Sub LancerImpression()
- ImprimerFichesPalette
- End Sub
- 'Imprime les fiches palettes en fonction des données inscrites dans le
- 'classeur excel sélectionné dans la cellule A1
- Private Sub ImprimerFichesPalette()
- Dim xlDoc As Excel.Workbook
- Dim xlDon As Excel.Worksheet
- Dim xlEti As Excel.Worksheet
- Dim Ligne As Integer
- On Error GoTo ImprimerFichesPalette_Error
- 'Test pour vérifier si une adresse de fichier est sélectionnée et qu'elle est valide
- Do
- If Not IsEmpty(Cells(1, 1)) Then
- If Dir(Cells(1, 1)) <> "" Then
- Exit Do
- End If
- Else
- If MsgBox("Le fichier de données n'est pas valide !" & vbCr & "Voulez-vous en sélectionner un maintenant ?", vbYesNo, "Erreur fichier" ) = vbYes Then
- ChoixFichier
- Else
- Exit Sub
- End If
- End If
- Loop
-
- 'Met en mémoire l'onglet contenant l'étiquette
- Set xlEti = ThisWorkbook.Worksheets("Etiquette" )
- 'Définition de la zone d'impression
- xlEti.PageSetup.PrintArea = "$A$4:$C$11"
-
- 'Ouvre le fichier sélectionné
- Set xlDoc = Workbooks.Open(Cells(1, 1))
- 'Met en mémoire l'onglet contenant les données (ici le 1er onglet)
- Set xlDon = xlDoc.Worksheets(1) '(1) pour 1er onglet
-
- 'Initialisation du n° de ligne contenant la 1ere donnée
- Ligne = 2
- 'Parcourt la liste du 1er onglet tant que la cellule de la 1ere colone soit vide
- Do While Not IsEmpty(xlDon.Cells(Ligne, 1))
- With xlEti
- 'Recopie des données vers l'étiquette
- .Cells(5, 1) = xlDon.Cells(Ligne, 1) 'N° tournée
- .Cells(5, 2) = xlDon.Cells(Ligne, 4) 'Récépissé
- .Cells(7, 1) = UCase(xlDon.Cells(Ligne, 2)) 'Destination en MAJUSCULE
- '.Cells(7, 1) = xlDon.Cells(Ligne, 2) 'Destination tel qu'écrit dans la base de donnée
- .Cells(9, 1) = UCase(xlDon.Cells(Ligne, 3)) 'Client en MAJUSCULE
- '.Cells(9, 1) = xlDon.Cells(Ligne, 3) 'Client tel qu'écrit dans la base de donnée
- .Cells(11, 1) = xlDon.Cells(Ligne, 5) 'Palette
- .Cells(11, 3) = xlDon.Cells(Ligne, 6) 'Nb colis
-
- 'Impression de l'étiquette
- .PrintOut Copies:=1, Collate:=True
-
- 'Ligne suivante
- Ligne = Ligne + 1
- End With
- Loop
- 'Ferme le fichier de données
- xlDoc.Close
- 'Libère les objets créés dans la mémoire
- Set xlDon = Nothing
- Set xlEti = Nothing
- Set xlDoc = Nothing
- 'Annule la zone d'impression
- ActiveSheet.PageSetup.PrintArea = ""
- On Error GoTo 0
- Exit Sub
- ImprimerFichesPalette_Error:
- MsgBox "Erreur " & Err.Number & " (" & Err.Description & " )", vbCritical
- End Sub
|
---------------
OtObOxBlOg - - - Etre seul à avoir tort c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
|