XL 2016 Création d'une étiquette CB avec Excel

mapomme à dit:

Bonjour à tous,

Un essai dans le classeur joint.

Je ne dispose pas de la police que vous utilisez pour afficher le code EAN39. J'ai donc utilisé la police libre de droit que j'ai dans mon Windows. En fichier joint la police, le fichier TTF de cette police (pour installer la police, double-cliquer sur le fichier après l'avoir téléchargé ).

A partir du fichier joint, pour utiliser votre propre police, remplacer dans le code "Free 3 of 9 Extended" par votre nom de police "IDAutomationHC39M". Faites de même pour la police de la colonne E de la feuille de calcul.

Cliquez sur le bouton Hop!

Le code dans Module1 :

VB:

Sub etiquette()
Dim derligne As Long, nbrcol As Long, nlig As Long, ncol As Long, j As Long, i As Long, s As String, ns As Long
   nbrcol = InputBox("Nombre de colonnes d'étiquettes ?", "Question")
   derligne = Cells(Rows.Count, "a").End(xlUp).Row

   Application.ScreenUpdating = False
   Range("h1").UnMerge
   Range("h1").CurrentRegion.Clear

   nlig = 2: ncol = 8: j = 1
   For i = 2 To derligne
      s = Cells(i, 1) & vbLf & Cells(i, 2) & " " & Cells(i, 3) & vbLf & "né(e) le: " & Cells(i, 4).Text & vbLf
      ns = Len(s)
      s = s & Cells(i, 5)
      Cells(nlig, ncol).Offset(, j - 1) = s
      Cells(nlig, ncol).Offset(, j - 1).Characters(Start:=ns + 1, Length:=99).Font.Name = "Free 3 of 9 Extended"
      Cells(nlig, ncol).Offset(, j - 1).Characters(Start:=ns + 1, Length:=99).Font.Size = 20
      j = j + 1
      If j > nbrcol Then j = 1: nlig = nlig + 1
   Next i
   Columns(ncol).Resize(, ncol).HorizontalAlignment = xlHAlignCenter
   Columns(ncol).Resize(, ncol).VerticalAlignment = xlHAlignCenter
   Columns(ncol).Resize(, ncol).ColumnWidth = 100
   Columns(ncol).Resize(, ncol).EntireColumn.AutoFit
   Columns(ncol).Resize(, ncol).ColumnWidth = Columns(ncol).ColumnWidth + 5
End Sub

Cliquez pour agrandir...