XL 2019 Créer un publipostage automatisé d'étiquettes

Phoneguy33

XLDnaute Nouveau
Bonjour,
Je m'explique: mon but est de créer un bouton qui lors du clique insère une feuille(nommé "Entrées") d'un autre classeur, ajoute 2 colonne sur cette feuille l'une nommée "type de zone " avec la formule affectée dans toute la colonne=SI.MULTIPLE([@Type];"Détecteur";"ZDA";"Déclencheur";"ZDM";"Alarme technique";"ZAT";"Non configuré";""), et l'autre nommée "numéro de zone" avec la formule suivant dans toute la colonne =SUBSTITUE(STXT([@Zone];2;CHERCHE("]";[@Zone];2));"]";"";1).

Je souhaite ensuite qu'un publipostage soit généré à partir de cette nouvelle feuille avec les étiquettes marque Avery A4/A5 référence L7656, et que dans ces étiquette soient générés automatiquement la mise en place de la sorte "type de zone" "numéro de zone" "n°".

j'ai essayé d'enregistrer la procédure en macro mais ça ne fonctionne pas , sur access ce serait sans doute plus efficace avec le gestionnaire de tables liées mais je ne maitrise pas assez ce logiciel.


Ci- joint le fameux fichier à insérer, merci pour votre aide
 

Pièces jointes

  • ETIQUETTES.xlsx
    50.7 KB · Affichages: 3

Phoneguy33

XLDnaute Nouveau
Bonjour Mise à jour de ma demande: j'ai réussi à faire à peut de chose près ce que je voulais mais je n'arrive pas à actualiser les etiquettes automatiquement de manière a ce que l'ensemble de mes étiquettes soit remplit avec les données de ma table.
Voici mon code :
Sub OuvrirFichierExcelEtSupprimerFeuillesEtAjouterColonnes()
'Activer les références pour word

Dim strFichier As String
Dim wb As Workbook
Dim ws As Worksheet
Dim strNomFichier As String
Dim strRepertoire As String
Dim strNomFichierCopie As String
Dim derniereColonne As Long
Dim startPos As Long
Dim endPos As Long
Dim numZone As String
Dim wdApp As Word.Application
Dim wdDoc As Word.Document

' Demande à l'utilisateur de sélectionner un fichier Excel
strFichier = Application.GetOpenFilename( _
FileFilter:="Fichiers Excel (*.xls;*.xlsx), *.xls;*.xlsx", _
Title:="Choisissez un fichier Excel à ouvrir")

' Vérifie si un fichier a été sélectionné
If strFichier <> "False" Then
' Récupère le nom et le répertoire du fichier Excel sélectionné
strNomFichier = Right(strFichier, Len(strFichier) - InStrRev(strFichier, "\", -1, vbTextCompare))
strRepertoire = Left(strFichier, InStrRev(strFichier, "\", -1, vbTextCompare))
' Définit le nom de la copie du fichier Excel
strNomFichierCopie = "Copie de " & strNomFichier

' Crée une copie du fichier Excel sélectionné
FileCopy strFichier, strRepertoire & strNomFichierCopie
' Ouvre la copie du fichier Excel
Set wb = Workbooks.Open(strRepertoire & strNomFichierCopie)

' Désactive les alertes pour éviter les boîtes de dialogue lors de la suppression des feuilles
Application.DisplayAlerts = False
' Supprime toutes les feuilles sauf "Entrées"
For Each ws In wb.Worksheets
If ws.Name <> "Entrées" Then
ws.Delete
End If
Next ws
' Vérifie si la feuille "Entrées" existe
If Not wb.Worksheets("Entrées") Is Nothing Then
Set ws = wb.Worksheets("Entrées")

' Ajoute une colonne "Type de zone" à droite de la dernière colonne utilisée
derniereColonne = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1
ws.Columns(derniereColonne).Insert
ws.Cells(1, derniereColonne).Value = "Type de zone"
ws.Range(ws.Cells(2, derniereColonne), ws.Cells(ws.Rows.Count, derniereColonne)).Formula = "=IF(D2=""Détecteur"",""ZDA"",IF(D2=""Déclencheur"",""ZDM"",IF(D2=""Alarme technique"",""ZAT"",IF(D2=""Non configuré"","""",""Non valide""))))"

' Ajoute une colonne "Numéro de zone" à droite de la colonne "Type de zone"
derniereColonne = derniereColonne + 1
ws.Columns(derniereColonne).Insert
ws.Cells(1, derniereColonne).Value = "Numéro de zone"
For i = 2 To ws.Rows.Count
If Len(ws.Cells(i, 10).Value) > 0 Then
startPos = InStr(ws.Cells(i, 10).Value, "[") + 1
endPos = InStr(ws.Cells(i, 10).Value, "]") - 1
numZone = Mid(ws.Cells(i, 10).Value, startPos, endPos - startPos + 1)
ws.Cells(i, derniereColonne).Value = numZone
End If

Next i
' Enregistre la copie du fichier Excel avec les modifications
wb.Save
' Ferme la copie du fichier Excel
wb.Close
' Réactive les alertes
Application.DisplayAlerts = True
Else
' Affiche un message d'erreur si la feuille "Entrées" n'existe pas
MsgBox "La feuille 'Entrées' n'existe pas dans le fichier sélectionné !", vbExclamation, "Erreur"
End If
End If
' Ouvre un nouveau fichier Word

Set wdApp = New Word.Application
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add

' Ouvre le fichier Excel comme une source de données pour le publipostage
wdDoc.MailMerge.OpenDataSource _
Name:=strRepertoire & strNomFichierCopie, _
LinkToSource:=True, _
Connection:="Entrées", _
SQLStatement:="SELECT * FROM `Entrées$`"

' Nettoyer les objets
wdApp.Selection.EndKey Unit:=wdStory
Set wdDoc = Nothing
Set wdApp = Nothing
Set ws = Nothing
wb.Close SaveChanges:=True
Set wb = Nothing




End Sub

et les fichiers demandés par la macro en pièce jointe. Merci d'avance pour votre aide!!
 

Pièces jointes

  • Copie de ETIQUETTES.xlsx
    64.9 KB · Affichages: 3
  • ETIQUETTES1.docx
    13.9 KB · Affichages: 2

Discussions similaires

Réponses
10
Affichages
1 K

Statistiques des forums

Discussions
315 089
Messages
2 116 094
Membres
112 658
dernier inscrit
doro 76