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!!