Bonjour le Forum !
J'explique mon problème : J'ai un fichier excel contenant des données (deux colonnes utiles : Nom/Prénom (Colonne D) et texte (Colonne C)). Je dois insérer pour une ligne, le texte à un endroit sur une feuille word, et le nom/prénom à un autre endroit. Pour ça, j'ai utilisé des signets, ça fonctionne très bien.
Le problème est que je dois dupliquer la première page avec le même modèle, autant de fois qu'il y a de ligne. Je n'ai donc aucun problème pour l'insertion, je suis surtout bloqué pour la duplication de ma page word.
Je précise également que j’exécute tout ça depuis un clique sur un bouton sur le fichier excel. Voici mon code :
Merci de votre aide, tout en sachant que je ne sais pas si c'est possible, j'attend donc vos réponses
J'explique mon problème : J'ai un fichier excel contenant des données (deux colonnes utiles : Nom/Prénom (Colonne D) et texte (Colonne C)). Je dois insérer pour une ligne, le texte à un endroit sur une feuille word, et le nom/prénom à un autre endroit. Pour ça, j'ai utilisé des signets, ça fonctionne très bien.
Le problème est que je dois dupliquer la première page avec le même modèle, autant de fois qu'il y a de ligne. Je n'ai donc aucun problème pour l'insertion, je suis surtout bloqué pour la duplication de ma page word.
Je précise également que j’exécute tout ça depuis un clique sur un bouton sur le fichier excel. Voici mon code :
Code:
Function GetFilesMaximes() As String
Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
f.Title = "Sélectionner le fichier des Maximes"
f.AllowMultiSelect = False
f.InitialFileName = ActiveWorkbook.Path
f.Show
If f.SelectedItems.Count > 0 Then
GetFilesMaximes = f.SelectedItems(1)
End If
Set f = Nothing
End Function
Function GetFilesAgent() As String
Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
f.Title = "Sélectionner le fichier des Agents"
f.AllowMultiSelect = False
f.InitialFileName = ActiveWorkbook.Path
f.Show
If f.SelectedItems.Count > 0 Then
GetFilesAgent = f.SelectedItems(1)
End If
Set f = Nothing
End Function
Function GetFilesChevalet() As String
Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
f.Title = "Sélectionner le fichier des Chevalets"
f.AllowMultiSelect = False
f.InitialFileName = ActiveWorkbook.Path
f.Show
If f.SelectedItems.Count > 0 Then
GetFilesChevalet = f.SelectedItems(1)
End If
Set f = Nothing
End Function
Sub createChevalet()
'Procédure générant un fichier word contenant les chevalets
Dim fichierAgent As String
Dim fichierMaximes As String
Dim WorkBookAgent As Workbook
Dim WorkBookMaximes As Workbook
Dim WorkBookPrincipal As Workbook
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim dernLigneAgent As Integer
Dim dernLigneMaxime As Integer
Dim i As Integer
Dim j As Integer
Dim ligneRandom As Integer
Dim data As New Collection
Set WorkBookPrincipal = ActiveWorkbook
'Vide les anciennes données s'il y en a
WorkBookPrincipal.Sheets("Récupération").Range("A1:C65536").ClearContents
'Récuperation des noms de fichiers où se trouvent les données
fichierAgent = GetFilesAgent
fichierMaximes = GetFilesMaximes
fichierChevalet = GetFilesChevalet
Set WorkBookAgent = Workbooks.Open(Filename:=fichierAgent) 'Ouverture du fichier Agent
'Récupère la dernière ligne remplit du fichier agent
'"Agents" à changer ainsi que la plage selon où se trouve le nom et prénom
dernLigneAgent = WorkBookAgent.Sheets("Agents").Range("A65536").End(xlUp).Row
WorkBookAgent.Sheets("Agents").Range("B2:C" & dernLigneAgent).Copy WorkBookPrincipal.Sheets("Récupération").Range("A1")
WorkBookAgent.Close savechanges:=False 'ferme le fichier
Randomize
Set WorkBookMaximes = Workbooks.Open(Filename:=fichierMaximes) 'Ouverture du fichier Maximes
'Récupère la dernière ligne remplit du fichier Maximes
dernLigneMaxime = WorkBookMaximes.Sheets("FC").Range("A65536").End(xlUp).Row
ligneRandom = ((dernLigneMaxime * Rnd - 2) + 2)
For i = 1 To dernLigneAgent - 1
For j = 1 To data.Count
If ligneRandom = data(j) Then
ligneRandom = ((dernLigneMaxime * Rnd - 2) + 2)
j = 1
End If
Next
data.Add ligneRandom
WorkBookMaximes.Sheets("FC").Range("A" & ligneRandom).Copy WorkBookPrincipal.Sheets("Récupération").Range("C" & i)
ligneRandom = ((dernLigneMaxime * Rnd - 2) + 2)
Next
WorkBookMaximes.Close savechanges:=False 'ferme le fichier
Set WordApp = CreateObject("word.application")
Set WordDoc = WordApp.Documents.Open(Filename:=fichierChevalet) 'Ouverture du fichier des chevalets
WordDoc.Bookmarks("nom").Range.Text = WorkBookPrincipal.Sheets("Récupération").Range("D1").Value
WordDoc.Bookmarks("maximes").Range.Text = WorkBookPrincipal.Sheets("Récupération").Range("C1")
WordApp.Quit
Set WordApp = Nothing
End Sub
Merci de votre aide, tout en sachant que je ne sais pas si c'est possible, j'attend donc vos réponses