Imprimer une étiquette Dymo directement à partir d'Excel, via macro VBA

Pour vous évitez des heures de recherche, j’ai écrit ici la macro directement utilisable. Vous n’avez qu’à l’ajouter dans l’éditeur de code VB, ajouter un bouton, et c’est bon !

J’ai fait une première macro pour imprimer une seule étiquette :

Sub ImprimerEtiquetteSimple()

    Dim myDymo As Object
    Dim dymoAddIn As Object
    Dim dymoLabels As Object

    ' Chemin de ton fichier .label
    Dim cheminLabel As String
    cheminLabel = "C:\Users\nicol\OneDrive\Documents\02 - Altarum\Plaquette and chartre graphique V2\Articles\Excel to dymo\label-produit.label"

    ' Nom exact de ton imprimante
    Dim imprimante As String
    imprimante = "DYMO LabelWriter 450 Turbo"

    On Error GoTo Erreur

    ' Création des objets DYMO
    Set myDymo = New DYMO_DLS_SDK.DymoHighLevelSDK
    Set dymoAddIn = myDymo.dymoAddIn
    Set dymoLabels = myDymo.dymoLabels

    ' Ouvre l'étiquette
    If dymoAddIn.Open(cheminLabel) = False Then
        MsgBox "Impossible d'ouvrir le fichier .label", vbCritical
        Exit Sub
    End If

    ' Remplace un champ (doit exister dans ton label)
    dymoLabels.SetField "produit", "Hello DYMO"

    ' Sélection de l’imprimante
    If dymoAddIn.SelectPrinter(imprimante) = False Then
        MsgBox "Imprimante introuvable", vbCritical
        Exit Sub
    End If

    ' Impression
    dymoAddIn.StartPrintJob
    dymoAddIn.EndPrintJob

    MsgBox "Étiquette imprimée !"

    Exit Sub

Erreur:
    MsgBox "Erreur : " & Err.Description, vbCritical

End Sub

Puis une version plus élaborée avec :

• ChoisirFichierLabel() pour choisir le modèle d’étiquette
• ChoisirImprimante() pour choisir l’imprimante
• Deux macros : une pour imprimer une seule ligne et une pour imprimer tout le tableau

Pour choisir le fichier .label :

Sub ChoisirFichierLabel()

    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Title = "Sélectionner un fichier DYMO (.label)"
        .Filters.Clear
        .Filters.Add "Fichiers DYMO", "*.label"
        .AllowMultiSelect = False

        If .Show = -1 Then
            g_CheminLabel = .SelectedItems(1)
            MsgBox "Fichier sélectionné :" & vbCrLf & g_CheminLabel, vbInformation
        Else
            MsgBox "Aucun fichier sélectionné.", vbExclamation
        End If
    End With

End Sub

Choix de l’imprimante :

Sub ChoisirImprimante()

    Dim nouvelleImprimante As String

    nouvelleImprimante = InputBox( _
        "Nom de l'imprimante DYMO :", _
        "Choisir imprimante", _
        g_NomImprimante)

    If Trim(nouvelleImprimante) = "" Then
        MsgBox "Aucune imprimante définie.", vbExclamation
        Exit Sub
    End If

    g_NomImprimante = nouvelleImprimante

    ' Sauvegarde
    SaveSetting "DYMO", "Config", "PrinterName", g_NomImprimante

    MsgBox "Imprimante définie :" & vbCrLf & g_NomImprimante, vbInformation

End Sub

Et finalement les macros pour imprimer :

Option Explicit

Public g_CheminLabel As String
Public g_NomImprimante As String

Sub ImprimerLigneSelectionnee()
    ImprimerEtiquetteDYMO False
End Sub

Sub ImprimerToutLeTableau()
    ImprimerEtiquetteDYMO True
End Sub

Sub ImprimerEtiquetteDYMO(Optional ByVal ToutLeTableau As Boolean = False)

    Dim myDymo As DYMO_DLS_SDK.DymoHighLevelSDK
    Dim dymoAddIn As Object
    Dim dymoLabels As Object

    Dim cheminLabel As String
    Dim imprimante As String

    Dim cell As Range
    Dim lo As ListObject
    Dim ligneTableau As Range
    Dim col As ListColumn

    Dim indexLigne As Long
    Dim nbImprimees As Long

    Dim nomChamp As String
    Dim valeurChamp As String

    On Error GoTo Erreur

    If g_CheminLabel = "" Then
        MsgBox "Aucun fichier label sélectionné. Lance d'abord 'ChoisirFichierLabel'.", vbExclamation
        Exit Sub
    End If

    cheminLabel = g_CheminLabel
    If g_NomImprimante = "" Then
        g_NomImprimante = "DYMO LabelWriter 450 Turbo"
    End If

imprimante = g_NomImprimante
    Set cell = ActiveCell

    If cell Is Nothing Then
        MsgBox "Aucune cellule sélectionnée.", vbExclamation
        Exit Sub
    End If

    On Error Resume Next
    Set lo = cell.ListObject
    On Error GoTo Erreur

    If lo Is Nothing Then
        MsgBox "La cellule sélectionnée n'est pas dans un tableau Excel.", vbExclamation
        Exit Sub
    End If

    If lo.DataBodyRange Is Nothing Then
        MsgBox "Le tableau ne contient aucune ligne.", vbExclamation
        Exit Sub
    End If

    If Intersect(cell, lo.DataBodyRange) Is Nothing Then
        MsgBox "Sélectionne une cellule dans une ligne de données du tableau.", vbExclamation
        Exit Sub
    End If

    Set myDymo = New DYMO_DLS_SDK.DymoHighLevelSDK
    Set dymoAddIn = myDymo.dymoAddIn
    Set dymoLabels = myDymo.dymoLabels

    If Not dymoAddIn.Open(cheminLabel) Then
        MsgBox "Impossible d'ouvrir le fichier .label", vbCritical
        Exit Sub
    End If

    If Not dymoAddIn.SelectPrinter(imprimante) Then
        MsgBox "Imprimante introuvable", vbCritical
        Exit Sub
    End If

    dymoAddIn.StartPrintJob

    If ToutLeTableau Then

        For Each ligneTableau In lo.DataBodyRange.Rows

            For Each col In lo.ListColumns
                nomChamp = Trim(CStr(col.Name))
                valeurChamp = GetCellText(ligneTableau.Cells(1, col.Index))

                On Error Resume Next
                dymoLabels.SetField nomChamp, valeurChamp
                On Error GoTo Erreur
            Next col

            dymoAddIn.Print2 1, False, 1
            nbImprimees = nbImprimees + 1
        Next ligneTableau

    Else

        indexLigne = cell.Row - lo.DataBodyRange.Row + 1
        Set ligneTableau = lo.DataBodyRange.Rows(indexLigne)

        For Each col In lo.ListColumns
            nomChamp = Trim(CStr(col.Name))
            valeurChamp = GetCellText(ligneTableau.Cells(1, col.Index))

            On Error Resume Next
            dymoLabels.SetField nomChamp, valeurChamp
            On Error GoTo Erreur
        Next col

        dymoAddIn.Print2 1, False, 1
        nbImprimees = 1

    End If

    dymoAddIn.EndPrintJob

    Exit Sub

Erreur:
    On Error Resume Next
    dymoAddIn.EndPrintJob
    MsgBox "Erreur : " & Err.Number & " - " & Err.Description, vbCritical

End Sub

Private Function GetCellText(ByVal c As Range) As String
    If IsError(c.Value) Then
        GetCellText = ""
    ElseIf IsEmpty(c.Value) Then
        GetCellText = ""
    Else
        GetCellText = CStr(c.Value)
    End If
End Function

Enjoy !