Bouton VBA outlook pour ouvrir fichier
Morpheuuss
Messages postés
14
Date d'inscription
Statut
Membre
Dernière intervention
-
danielc0 Messages postés 1858 Date d'inscription Statut Membre Dernière intervention -
danielc0 Messages postés 1858 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai un code VBA sur outlook qui me permet de lire différents rapports de mail et d'en faire des excels. Ensuite j'ai une fonction qui 'rassemble' tous ces excels en un seul, mais je voudrais également un bouton (dans la case E1 du fichier finale, sa position n'as pas d'importance pour l'instant) qui me permette d'ouvrir mon fichier de config lorsque je clique dessus. Ce fichier est utilisé pour la création de chaque excel.
Voici le code de la fonction qui rassemble tous les excels :
Sub Merge()
Dim sourceWorkbookNAS As Workbook
Dim sourceWorkbookAcronis As Workbook
Dim sourceWorkbookBootCatalog As Workbook
Dim sourceWorkbookPRTG As Workbook
Dim destinationWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim sourceFilePathNAS As String
Dim sourceFilePathAcronis As String
Dim sourceFilePathBootCatalog As String
Dim sourceFilePathPRTG As String
Dim destinationFilePath As String
Dim configFilePath As String
Dim sourceIndex As Integer
Dim destinationIndex As Integer
Dim lastRow As Long
Dim currentDate As Date
Dim formatdate As String
Dim ws As Worksheet
' Chemins des fichiers source et destination
formatdate = Format(Date, "dd_MM_yyyy")
sourceFilePathNAS = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_NAS.xlsx"
sourceFilePathAcronis = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_Acronis.xlsx"
sourceFilePathBootCatalog = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_BootCatalog.xlsx"
sourceFilePathPRTG = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_PRTG.xlsx"
destinationFilePath = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_consolidated_report.xlsx"
configFilePath = Environ("USERPROFILE") & "\Documents\mail\config.xlsx" ' Fichier Config pour gérer les noms des appareils
' Ouvrir les fichiers source et destination
Set sourceWorkbookNAS = Workbooks.Open(sourceFilePathNAS)
Set sourceWorkbookAcronis = Workbooks.Open(sourceFilePathAcronis)
Set sourceWorkbookBootCatalog = Workbooks.Open(sourceFilePathBootCatalog)
Set sourceWorkbookPRTG = Workbooks.Open(sourceFilePathPRTG)
Set destinationWorkbook = Workbooks.Open(destinationFilePath)
' Initialiser les indices pour les feuilles
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Commencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données NAS dynamiquement
Do While sourceIndex <= sourceWorkbookNAS.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookNAS.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date du NAS
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
' Fusionner A6 et B6, et les définir égal à A1 du fichier source (date)
With destinationSheet.Range("A6:B6")
.Merge ' Fusionner les cellules A6 et B6
.Value = sourceSheet.Range("A2").Value ' Prendre la valeur de A2 du fichier source
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
' Mettre en place les en-têtes "Description" et "Statut"
destinationSheet.Range("A7").Value = "Description"
destinationSheet.Range("B7").Value = "Statut"
' Boucle dynamique pour transférer les données des NAS
Dim i As Long
For i = 3 To lastRow
destinationSheet.Cells(5 + i, 1).Value = .Cells(i, 1).Value ' Colonne A (Nom NAS)
destinationSheet.Cells(5 + i, 2).Value = .Cells(i, 2).Value ' Colonne B (Statut NAS)
Next i
End With
' Appliquer la couleur bleu clair aux cellules A8 jusqu'à la dernière ligne
With destinationSheet.Range("A7:B" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage A6:B(lastRow)
With destinationSheet.Range("A6:B" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la mise en forme conditionnelle pour le statut des NAS si nécessaire
ApplyConditionalFormattingNAS destinationSheet, lastRow
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles Acronis
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données Acronis
Do While sourceIndex <= sourceWorkbookAcronis.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookAcronis.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date d'Acronis
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
' Fusionner C6 et D6, et les définir égal à A2 et B2 du fichier source
With destinationSheet.Range("C6:D6")
.Merge ' Fusionner les cellules C6 et D6
.Value = sourceSheet.Range("A2").Value ' Prendre la valeur de A2 du fichier source
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
destinationSheet.Range("C7").Value = "Description"
destinationSheet.Range("D7").Value = .Range("B2").Value
Dim j As Long
For j = 3 To lastRow
destinationSheet.Cells(5 + j, 3).Value = .Cells(j, 1).Value ' C column
destinationSheet.Cells(5 + j, 4).Value = .Cells(j, 2).Value ' D column
Next j
End With
' Appliquer la couleur bleu clair aux cellules C8 jusqu'à la dernière ligne
With destinationSheet.Range("C7:D" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage C7:D11
With destinationSheet.Range("C6:D" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la couleur verte ou rouge selon la valeur des cellules D12 et D13
ApplyConditionalFormattingAcronis destinationSheet, lastRow
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles PRTG
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Appliquer la couleur #18323F de E6:E10
For Each ws In destinationWorkbook.Sheets
ws.Range("E6:E10").Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
Next ws
' Transférer les données PRTG
Do While sourceIndex <= sourceWorkbookPRTG.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookPRTG.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date de PRTG
With sourceSheet
' Fusionner F6 et G6
With destinationSheet.Range("F6:G6")
.Merge ' Fusionner les cellules F6 et G6
.Value = "PRTG"
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
destinationSheet.Range("F7").Value = "Description"
destinationSheet.Range("G7").Value = .Range("B2").Value
Dim k As Long
For k = 3 To lastRow
destinationSheet.Cells(5 + k, 6).Value = .Cells(k, 1).Value ' F column
destinationSheet.Cells(5 + k, 7).Value = .Cells(k, 2).Value ' G column
Next k
' Appliquer la couleur bleu clair aux cellules F7 jusqu'à la dernière ligne
With destinationSheet.Range("F7:G" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage F7 jusqu'à la dernière ligne
With destinationSheet.Range("F6:G" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la couleur verte ou rouge selon la valeur des cellules G13 et au-delà
ApplyConditionalFormattingPRTG destinationSheet, lastRow
End With
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles Boot Catalog
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données Boot Catalog
Do While sourceIndex <= sourceWorkbookBootCatalog.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookBootCatalog.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date de Boot Catalog
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
destinationSheet.Range("U11").Value = .Range("A1").Value
destinationSheet.Range("U12").Value = .Range("A2").Value
destinationSheet.Range("V12").Value = .Range("B2").Value
Dim l As Long
For l = 3 To lastRow
destinationSheet.Cells(10 + l, 21).Value = .Cells(l, 1).Value ' T column
destinationSheet.Cells(10 + l, 22).Value = .Cells(l, 2).Value ' U column
Next l
End With
' Appliquer la couleur bleu clair aux cellules T12 et U12
With destinationSheet.Range("U12:U" & (10 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Mettre en forme le fichier destination et ajouter un bouton à chaque feuille
For Each ws In destinationWorkbook.Sheets
' Centrage du contenu de la feuille
ws.Cells.HorizontalAlignment = xlCenter
ws.Cells.VerticalAlignment = xlCenter
ws.Columns.AutoFit
Next ws
' Enregistrer et fermer les classeurs
destinationWorkbook.Close SaveChanges:=True
sourceWorkbookNAS.Close SaveChanges:=False
sourceWorkbookAcronis.Close SaveChanges:=False
sourceWorkbookBootCatalog.Close SaveChanges:=False
sourceWorkbookPRTG.Close SaveChanges:=False
'wbConfig.Close SaveChanges:=True
'Supprimer les fichiers sources
Kill sourceFilePathNAS
Kill sourceFilePathAcronis
Kill sourceFilePathBootCatalog
Kill sourceFilePathPRTG
' Libérer la mémoire
Set sourceSheet = Nothing
Set sourceWorkbookNAS = Nothing
Set sourceWorkbookAcronis = Nothing
Set sourceWorkbookBootCatalog = Nothing
Set destinationSheet = Nothing
Set destinationWorkbook = Nothing
Set wbConfig = Nothing
End Sub
A voir également:
- Bouton VBA outlook pour ouvrir fichier
- Comment ouvrir un fichier epub ? - Guide
- Ouvrir fichier .bin - Guide
- Ouvrir fichier .dat - Guide
- Comment ouvrir un fichier docx ? - Guide
- Comment ouvrir un fichier 7z - Guide
15 réponses
Sub Merge()
Dim sourceWorkbookNAS As Workbook
Dim sourceWorkbookAcronis As Workbook
Dim sourceWorkbookBootCatalog As Workbook
Dim sourceWorkbookPRTG As Workbook
Dim destinationWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim sourceFilePathNAS As String
Dim sourceFilePathAcronis As String
Dim sourceFilePathBootCatalog As String
Dim sourceFilePathPRTG As String
Dim destinationFilePath As String
Dim configFilePath As String
Dim sourceIndex As Integer
Dim destinationIndex As Integer
Dim lastRow As Long
Dim currentDate As Date
Dim formatdate As String
Dim ws As Worksheet
' Chemins des fichiers source et destination
formatdate = Format(Date, "dd_MM_yyyy")
sourceFilePathNAS = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_NAS.xlsx"
sourceFilePathAcronis = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_Acronis.xlsx"
sourceFilePathBootCatalog = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_BootCatalog.xlsx"
sourceFilePathPRTG = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_PRTG.xlsx"
destinationFilePath = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_consolidated_report.xlsx"
configFilePath = Environ("USERPROFILE") & "\Documents\mail\config.xlsx" ' Fichier Config pour gérer les noms des appareils
' Ouvrir les fichiers source et destination
Set sourceWorkbookNAS = Workbooks.Open(sourceFilePathNAS)
Set sourceWorkbookAcronis = Workbooks.Open(sourceFilePathAcronis)
Set sourceWorkbookBootCatalog = Workbooks.Open(sourceFilePathBootCatalog)
Set sourceWorkbookPRTG = Workbooks.Open(sourceFilePathPRTG)
Set destinationWorkbook = Workbooks.Open(destinationFilePath)
' Initialiser les indices pour les feuilles
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Commencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données NAS dynamiquement
Do While sourceIndex <= sourceWorkbookNAS.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookNAS.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date du NAS
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
' Fusionner A6 et B6, et les définir égal à A1 du fichier source (date)
With destinationSheet.Range("A6:B6")
.Merge ' Fusionner les cellules A6 et B6
.Value = sourceSheet.Range("A2").Value ' Prendre la valeur de A2 du fichier source
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
' Mettre en place les en-têtes "Description" et "Statut"
destinationSheet.Range("A7").Value = "Description"
destinationSheet.Range("B7").Value = "Statut"
' Boucle dynamique pour transférer les données des NAS
Dim i As Long
For i = 3 To lastRow
destinationSheet.Cells(5 + i, 1).Value = .Cells(i, 1).Value ' Colonne A (Nom NAS)
destinationSheet.Cells(5 + i, 2).Value = .Cells(i, 2).Value ' Colonne B (Statut NAS)
Next i
End With
' Appliquer la couleur bleu clair aux cellules A8 jusqu'à la dernière ligne
With destinationSheet.Range("A7:B" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage A6:B(lastRow)
With destinationSheet.Range("A6:B" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la mise en forme conditionnelle pour le statut des NAS si nécessaire
ApplyConditionalFormattingNAS destinationSheet, lastRow
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles Acronis
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données Acronis
Do While sourceIndex <= sourceWorkbookAcronis.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookAcronis.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date d'Acronis
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
' Fusionner C6 et D6, et les définir égal à A2 et B2 du fichier source
With destinationSheet.Range("C6:D6")
.Merge ' Fusionner les cellules C6 et D6
.Value = sourceSheet.Range("A2").Value ' Prendre la valeur de A2 du fichier source
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
destinationSheet.Range("C7").Value = "Description"
destinationSheet.Range("D7").Value = .Range("B2").Value
Dim j As Long
For j = 3 To lastRow
destinationSheet.Cells(5 + j, 3).Value = .Cells(j, 1).Value ' C column
destinationSheet.Cells(5 + j, 4).Value = .Cells(j, 2).Value ' D column
Next j
End With
' Appliquer la couleur bleu clair aux cellules C8 jusqu'à la dernière ligne
With destinationSheet.Range("C7:D" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage C7:D11
With destinationSheet.Range("C6:D" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la couleur verte ou rouge selon la valeur des cellules D12 et D13
ApplyConditionalFormattingAcronis destinationSheet, lastRow
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles PRTG
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Appliquer la couleur #18323F de E6:E10
For Each ws In destinationWorkbook.Sheets
ws.Range("E6:E10").Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
Next ws
' Transférer les données PRTG
Do While sourceIndex <= sourceWorkbookPRTG.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookPRTG.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date de PRTG
With sourceSheet
' Fusionner F6 et G6
With destinationSheet.Range("F6:G6")
.Merge ' Fusionner les cellules F6 et G6
.Value = "PRTG"
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
destinationSheet.Range("F7").Value = "Description"
destinationSheet.Range("G7").Value = .Range("B2").Value
Dim k As Long
For k = 3 To lastRow
destinationSheet.Cells(5 + k, 6).Value = .Cells(k, 1).Value ' F column
destinationSheet.Cells(5 + k, 7).Value = .Cells(k, 2).Value ' G column
Next k
' Appliquer la couleur bleu clair aux cellules F7 jusqu'à la dernière ligne
With destinationSheet.Range("F7:G" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage F7 jusqu'à la dernière ligne
With destinationSheet.Range("F6:G" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la couleur verte ou rouge selon la valeur des cellules G13 et au-delà
ApplyConditionalFormattingPRTG destinationSheet, lastRow
End With
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles Boot Catalog
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données Boot Catalog
Do While sourceIndex <= sourceWorkbookBootCatalog.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookBootCatalog.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date de Boot Catalog
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
destinationSheet.Range("U11").Value = .Range("A1").Value
destinationSheet.Range("U12").Value = .Range("A2").Value
destinationSheet.Range("V12").Value = .Range("B2").Value
Dim l As Long
For l = 3 To lastRow
destinationSheet.Cells(10 + l, 21).Value = .Cells(l, 1).Value ' T column
destinationSheet.Cells(10 + l, 22).Value = .Cells(l, 2).Value ' U column
Next l
End With
' Appliquer la couleur bleu clair aux cellules T12 et U12
With destinationSheet.Range("U12:U" & (10 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Mettre en forme le fichier destination et ajouter un bouton à chaque feuille
For Each ws In destinationWorkbook.Sheets
' Centrage du contenu de la feuille
ws.Cells.HorizontalAlignment = xlCenter
ws.Cells.VerticalAlignment = xlCenter
ws.Columns.AutoFit
Next ws
' Enregistrer et fermer les classeurs
destinationWorkbook.Close SaveChanges:=True
sourceWorkbookNAS.Close SaveChanges:=False
sourceWorkbookAcronis.Close SaveChanges:=False
sourceWorkbookBootCatalog.Close SaveChanges:=False
sourceWorkbookPRTG.Close SaveChanges:=False
'wbConfig.Close SaveChanges:=True
'Supprimer les fichiers sources
Kill sourceFilePathNAS
Kill sourceFilePathAcronis
Kill sourceFilePathBootCatalog
Kill sourceFilePathPRTG
' Libérer la mémoire
Set sourceSheet = Nothing
Set sourceWorkbookNAS = Nothing
Set sourceWorkbookAcronis = Nothing
Set sourceWorkbookBootCatalog = Nothing
Set destinationSheet = Nothing
Set destinationWorkbook = Nothing
Set wbConfig = Nothing
End Sub
Voici le code un peu plus organisé, je ne sais pas pourquoi la mise en page à sauté.
Bonjour,
Mets cette macro dans un module standard et rattache-la au bouton :
Sub OuvrirConfig()
Workbooks.Open Environ("USERPROFILE") & "\Documents\mail\config.xlsx"
End Sub
Daniel
Merci, mais je n'arrive tous de mêmes pas à créer le bouton via le code VBA est ensuite le relier à la macro afin de l'exécuter. J'ai rajouter ce code pour créer le bouton pour chaque feuille de mon classeur :
For Each ws In destinationWorkbook.Sheets
ws.Buttons.Add(400, 10, 100, 30).OnAction = "OuvrirConfig"
ws.Buttons(1).Characters.Text = "Ouvrir Config"
Next ws
Mais lorsque je clique sur le bouton dans mon fichier excel, il me dit : "impossible d'exécuter la macro 'OuvrirConfig'. Il est possible qu'elle ne soit pas disponible dans ce classeur"
Ca devrait fonctionner. Tu n'as pas laissé aussi la macro dans un module feuille ? Si tu ne trouves pas, partage ton classeur.
Daniel
Bonjour,
Regarde le classeur :
https://www.cjoint.com/c/NJwhuXZCgT3
J'ai enregistré le classeur au format .xlsm (supportant les macros) et j'ai ajouté un module standard dans le quel j'ai mis OuvrirConfig.
Daniel
Je ne savais pas qu'il fallait que le fichier soit en .xlsm pour utilisé les macros, merci.
Toutefois, j'ai toujours le problème :
Dans ma fonction qui crée le fichier "consolidated_report", j'ai fais en sorte qu'il se créer en .xlsm (sans soucis, lorsque je regarde les propriété de mon fichier il est dans le bon format). Mais la fonction qui crée le bouton et qui est censé lui affecter la macro :
' Créer un bouton pour ouvrir le fichier de config sur chaque feuille avec la fonction OuvrirConfig() en tant que macro
For Each ws In destinationWorkbook.Sheets
ws.Buttons.Add(400, 10, 100, 30).OnAction = "OuvrirConfig"
ws.Buttons(1).Characters.Text = "Ouvrir Config"
Next ws
Dans mon fichier de report lorsque je clique sur le bouton, il me dit toujours "Impossible d'exécuter la macro "OuvrirConfig". Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées". Je ne sais pas si ça a avoir avec le fais que c'est à partir de outlook que j'essaie de lui affecter la macro même si je ne comprendrai pas pourquoi.
Et ducoup, j'ai changer le format aussi dans la macro :
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionJe ne suis pas sûr de comprendre. Ce n'est pas le fichier config qui doit être au format .xlsm, c'est celui qui comprend les macros (à moins que ce soit le même ???). Dans tous les cas, partage les classeurs qui posent problème.
"mais n'as pas la macro que je lui affecte " POURQUOI ???
https://www.cjoint.com/c/NJwjKusfRu3
Est-ce que le classeur à bien été créé par toi ? S'il provient d'internet, tu dois avoir ce bandeau rouge à l'ouverture du classeur (en français) :
il faut le débloquer dans les propriétés du fichier :
Daniel
Je suis pas sur d'avoir compris, si vous me demandez est ce que quand je télécharge le lien que vous m'avez renvoyé ça fonctionne, la réponse est oui sinon je n'ai pas compris la question
Désolé, je pense plus vite que j'écris. C'est en effet incompréhensible. Je voulais donc dire :
Est-ce que tu as toujours le même problème avec le classeur que je t'ai retourné et qui fonctionne ici ?
Ca fonctionne donc chez toi. Le problème est donc résolu ?
Daniel
Non, le problème n'est pas réglé. Le classeur que vous m'avez retourné, fonctionne effectivement, seulement je pense qu'on c'est pas exactement compris sur ce que je veux.
Pour faire simple, j'ai un code de plus de 1200 lignes sur outlook qui fait en sorte de lire différents rapports de mail. Il crée ensuite, à partir de ces mails, 4 excels (car j'ai quatre dossier différents contenant des rapports), je les "rassemble" en 1 seul fichier excel (nommé "dateDuJour_consolidated_report"). Et dans ce rapport 'final', je voudrais qu'il y est un bouton qui permettre d'ouvrir le fichier de config utilisé pour les différents excels de rapport.
En gros j'ai ça dans outlook :
Ensuite j'ai crée une icone qui lancer le 'module11' :
Et à la fin, j'obtiens mon classeur finale nommé "dateDuJour_consolidated_report" avec le bouton mais il ne contient pas la macro : https://www.cjoint.com/c/NJwnypDlBxY
Deux choses à régler au préalable :
1. Ouvre le classeur contenant la macro Merge. Clique sur Fichier, Options, Centre de gestion de la confidentialité, Paramètres du Centre de gestion de la confidentialité. Dans Paramètres des macros, coche la case "Accès approuvé au modèle d'objet du projet VBA. Valide. Enregistre le classeur.
2. Dans l'éditeur VBA, clique sur Outils, Références. Coche la case "Microsoft Visual Basic For Applications Extensibility 5.3". Valide. Enregistre le classeur.
J'ai ajouté ce code :
'*** ajout du module "Module9" dans le fichier destination
'*** la référence "Microsoft Visual Basic For Applications Extensibility 5.3" doit être cochée
Dim proj As VBIDE.VBProject
Dim comp As VBIDE.VBComponent
Set proj = destinationWorkbook.VBProject
Set comp = proj.VBComponents.Add(vbext_ct_StdModule)
comp.Name = "Module9"
Set codeMod = comp.CodeModule
With codeMod
lineNum = .CountOfLines + 1
.InsertLines lineNum, "Sub OuvrirConfig()"
lineNum = lineNum + 1
.InsertLines lineNum, " Workbooks.Open Environ(""USERPROFILE"") & ""\Documents\mail\config.xlsx"""
lineNum = lineNum + 1
.InsertLines lineNum, "End Sub"
End With
avant la ligne :
' Enregistrer et fermer les classeurs
Soit le code complet (il manque l'ajout des boutons) :
Sub Merge()
Dim sourceWorkbookNAS As Workbook
Dim sourceWorkbookAcronis As Workbook
Dim sourceWorkbookBootCatalog As Workbook
Dim sourceWorkbookPRTG As Workbook
Dim destinationWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim sourceFilePathNAS As String
Dim sourceFilePathAcronis As String
Dim sourceFilePathBootCatalog As String
Dim sourceFilePathPRTG As String
Dim destinationFilePath As String
Dim configFilePath As String
Dim sourceIndex As Integer
Dim destinationIndex As Integer
Dim lastRow As Long
Dim currentDate As Date
Dim formatdate As String
Dim ws As Worksheet
' Chemins des fichiers source et destination
formatdate = Format(Date, "dd_MM_yyyy")
sourceFilePathNAS = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_NAS.xlsx"
sourceFilePathAcronis = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_Acronis.xlsx"
sourceFilePathBootCatalog = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_BootCatalog.xlsx"
sourceFilePathPRTG = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_checkup_PRTG.xlsx"
destinationFilePath = Environ("USERPROFILE") & "\Documents\mail\" & formatdate & "_consolidated_report.xlsx"
configFilePath = Environ("USERPROFILE") & "\Documents\mail\config.xlsx" ' Fichier Config pour gérer les noms des appareils
' Ouvrir les fichiers source et destination
Set sourceWorkbookNAS = Workbooks.Open(sourceFilePathNAS)
Set sourceWorkbookAcronis = Workbooks.Open(sourceFilePathAcronis)
Set sourceWorkbookBootCatalog = Workbooks.Open(sourceFilePathBootCatalog)
Set sourceWorkbookPRTG = Workbooks.Open(sourceFilePathPRTG)
Set destinationWorkbook = Workbooks.Open(destinationFilePath)
' Initialiser les indices pour les feuilles
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Commencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données NAS dynamiquement
Do While sourceIndex <= sourceWorkbookNAS.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookNAS.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date du NAS
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
' Fusionner A6 et B6, et les définir égal à A1 du fichier source (date)
With destinationSheet.Range("A6:B6")
.Merge ' Fusionner les cellules A6 et B6
.Value = sourceSheet.Range("A2").Value ' Prendre la valeur de A2 du fichier source
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
' Mettre en place les en-têtes "Description" et "Statut"
destinationSheet.Range("A7").Value = "Description"
destinationSheet.Range("B7").Value = "Statut"
' Boucle dynamique pour transférer les données des NAS
Dim i As Long
For i = 3 To lastRow
destinationSheet.Cells(5 + i, 1).Value = .Cells(i, 1).Value ' Colonne A (Nom NAS)
destinationSheet.Cells(5 + i, 2).Value = .Cells(i, 2).Value ' Colonne B (Statut NAS)
Next i
End With
' Appliquer la couleur bleu clair aux cellules A8 jusqu'à la dernière ligne
With destinationSheet.Range("A7:B" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage A6:B(lastRow)
With destinationSheet.Range("A6:B" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la mise en forme conditionnelle pour le statut des NAS si nécessaire
ApplyConditionalFormattingNAS destinationSheet, lastRow
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles Acronis
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données Acronis
Do While sourceIndex <= sourceWorkbookAcronis.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookAcronis.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date d'Acronis
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
' Fusionner C6 et D6, et les définir égal à A2 et B2 du fichier source
With destinationSheet.Range("C6:D6")
.Merge ' Fusionner les cellules C6 et D6
.Value = sourceSheet.Range("A2").Value ' Prendre la valeur de A2 du fichier source
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
destinationSheet.Range("C7").Value = "Description"
destinationSheet.Range("D7").Value = .Range("B2").Value
Dim j As Long
For j = 3 To lastRow
destinationSheet.Cells(5 + j, 3).Value = .Cells(j, 1).Value ' C column
destinationSheet.Cells(5 + j, 4).Value = .Cells(j, 2).Value ' D column
Next j
End With
' Appliquer la couleur bleu clair aux cellules C8 jusqu'à la dernière ligne
With destinationSheet.Range("C7:D" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage C7:D11
With destinationSheet.Range("C6:D" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la couleur verte ou rouge selon la valeur des cellules D12 et D13
ApplyConditionalFormattingAcronis destinationSheet, lastRow
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles PRTG
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Appliquer la couleur #18323F de E6:E10
For Each ws In destinationWorkbook.Sheets
ws.Range("E6:E10").Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
Next ws
' Transférer les données PRTG
Do While sourceIndex <= sourceWorkbookPRTG.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookPRTG.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date de PRTG
With sourceSheet
' Fusionner F6 et G6
With destinationSheet.Range("F6:G6")
.Merge ' Fusionner les cellules F6 et G6
.Value = "PRTG"
.Font.Size = 18 ' Taille de police 18
.Font.Bold = True ' Mettre en gras
.Font.Color = RGB(255, 255, 255) ' Couleur du texte en blanc
.Interior.Color = RGB(24, 50, 63) ' Fond égal à #18323F (converti en RGB)
.HorizontalAlignment = xlCenter ' Centrer le texte horizontalement
.VerticalAlignment = xlCenter ' Centrer le texte verticalement
End With
destinationSheet.Range("F7").Value = "Description"
destinationSheet.Range("G7").Value = .Range("B2").Value
Dim k As Long
For k = 3 To lastRow
destinationSheet.Cells(5 + k, 6).Value = .Cells(k, 1).Value ' F column
destinationSheet.Cells(5 + k, 7).Value = .Cells(k, 2).Value ' G column
Next k
' Appliquer la couleur bleu clair aux cellules F7 jusqu'à la dernière ligne
With destinationSheet.Range("F7:G" & (5 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
' Appliquer des bordures sur la plage F7 jusqu'à la dernière ligne
With destinationSheet.Range("F6:G" & (5 + lastRow)).Borders
.LineStyle = xlContinuous ' Style de ligne continu
.Weight = xlThin ' Épaisseur de la bordure (fine)
.ColorIndex = 0 ' Couleur noire par défaut
End With
' Appliquer la couleur verte ou rouge selon la valeur des cellules G13 et au-delà
ApplyConditionalFormattingPRTG destinationSheet, lastRow
End With
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Réinitialiser les indices pour les feuilles Boot Catalog
sourceIndex = 1
destinationIndex = destinationWorkbook.Sheets.Count ' Recommencer à la dernière feuille du destinationWorkbook
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Transférer les données Boot Catalog
Do While sourceIndex <= sourceWorkbookBootCatalog.Sheets.Count And destinationIndex >= 1
Set sourceSheet = sourceWorkbookBootCatalog.Sheets(sourceIndex)
Set destinationSheet = destinationWorkbook.Sheets(destinationIndex)
' Trouver la dernière ligne avec des données dans la feuille source
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
' Renommer la feuille de destination
RenameSheet destinationSheet, sourceSheet.Range("A1").Value ' Utilisation de A1 pour la date de Boot Catalog
' Transférer les données dynamiques
If lastRow >= 3 Then
With sourceSheet
destinationSheet.Range("U11").Value = .Range("A1").Value
destinationSheet.Range("U12").Value = .Range("A2").Value
destinationSheet.Range("V12").Value = .Range("B2").Value
Dim l As Long
For l = 3 To lastRow
destinationSheet.Cells(10 + l, 21).Value = .Cells(l, 1).Value ' T column
destinationSheet.Cells(10 + l, 22).Value = .Cells(l, 2).Value ' U column
Next l
End With
' Appliquer la couleur bleu clair aux cellules T12 et U12
With destinationSheet.Range("U12:U" & (10 + lastRow))
.Interior.Color = RGB(173, 216, 230) ' Bleu clair
End With
End If
' Passer à la feuille suivante dans source et précédente dans destination
sourceIndex = sourceIndex + 1
destinationIndex = destinationIndex - 1
Loop
' Mettre en forme le fichier destination et ajouter un bouton à chaque feuille
For Each ws In destinationWorkbook.Sheets
' Centrage du contenu de la feuille
ws.Cells.HorizontalAlignment = xlCenter
ws.Cells.VerticalAlignment = xlCenter
ws.Columns.AutoFit
Next ws
'*** ajout du module "Module9" dans le fichier destination
'*** la référence "Microsoft Visual Basic For Applications Extensibility 5.3" doit être cochée
Dim proj As VBIDE.VBProject
Dim comp As VBIDE.VBComponent
Set proj = destinationWorkbook.VBProject
Set comp = proj.VBComponents.Add(vbext_ct_StdModule)
comp.Name = "Module9"
Set codeMod = comp.CodeModule
With codeMod
lineNum = .CountOfLines + 1
.InsertLines lineNum, "Sub OuvrirConfig()"
lineNum = lineNum + 1
.InsertLines lineNum, " Workbooks.Open Environ(""USERPROFILE"") & ""\Documents\mail\config.xlsx"""
lineNum = lineNum + 1
.InsertLines lineNum, "End Sub"
End With
' Enregistrer et fermer les classeurs
destinationWorkbook.Close SaveChanges:=True
sourceWorkbookNAS.Close SaveChanges:=False
sourceWorkbookAcronis.Close SaveChanges:=False
sourceWorkbookBootCatalog.Close SaveChanges:=False
sourceWorkbookPRTG.Close SaveChanges:=False
'wbConfig.Close SaveChanges:=True
'Supprimer les fichiers sources
Kill sourceFilePathNAS
Kill sourceFilePathAcronis
Kill sourceFilePathBootCatalog
Kill sourceFilePathPRTG
' Libérer la mémoire
Set sourceSheet = Nothing
Set sourceWorkbookNAS = Nothing
Set sourceWorkbookAcronis = Nothing
Set sourceWorkbookBootCatalog = Nothing
Set destinationSheet = Nothing
Set destinationWorkbook = Nothing
Set wbConfig = Nothing
End Sub
Note : Tu peux ôter la macro OuvrirConfig du code Outlook.
Daniel
On a encore un petit soucis, le soucis étant qu'enfaite je n'ai pas accès au classeur au préalable, enfaite Merge() est une fonction qui rassemble tous les excels en 1 seul puis après l'avoir fais, j'ai accès au classeur final. Seulement je voudrais que lorsque que j'y est accès, le bouton soit déjà paramétré avec la macro.
Je sais pas si c'est clair, mais en gros il faut retenir que je ne peux pas accéder au classeur, je gère absolument tout via le code. Ce que je voudrais c'est qu'a aucun moment je n'ai besoin d'ouvrir le classeur pour faire fonctionner la macro.
Ce que je t'ai dit, c'est à faire une seule fois. Le point 1 doit être fait sur l'ordi qui exécute la macro Merge. C'est obligatoire.
Le point 2 doit être fait dans le classeur qui contient la macro Merge, une fois pour toutes. Je suppose que si tu peux modifier la macro, tu peu modifier les références ? A la limite, ce point peut être réglé via VBA.
Sinon, l'alternative serait de faire l'ajout à l'ouverture du classeur de destination. Reste que l'"Accès approuvé au modèle d'objet du projet VBA" devra être activé sur l'ordi qui ouvrira la classeur.
