Ecrire depuis un fichier Excel, vers un autre ?

Le 10/09/2018 à 15:39

Bonjour,

J'arrive à lire des données d'un fichier excel autre que le mien, mais l'écriture est impossible !

Bon j'ai un fichier Excel, à partir duquel via ma macro, je souhaite mettre à jour un autre fichier et l'enregistrer/exporter en pdf.

Pour commentaire, le shFrom, c'est le nom de la feuille qui appelle la macro

Sub export_2days_training(sheet_From As Worksheet)

Dim sh_Attendance As Worksheet
Dim Cell_attendance As Range
'Correction*****************************
Dim curCell As Range
'******************************************
Dim Fichier_pdf As String
Dim fichier_A_ouvrir As String
Dim fichier_A_ouvrir_Attendance_form As Workbook
Dim shFrom As Worksheet

Set shFrom = sheet_From

If shFrom.CodeName = "Feuil3" Then
   Set curCell = shFrom.Range("D5")
ElseIf shFrom.CodeName = "Feuil5" Then
   Set curCell = shFrom.Range("D5")
End If

Set fic_A_ouvrir_Attendance_form = Application.Workbooks.Open(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & fichier_A_ouvrir, True)
If shFrom.CodeName = "Feuil3" Then
'Ici le but c est d aller définir sh_attendance sur le range de l onglet group attendance form = Sheet1 du fichier
'..\10_Attendance_Sheet_Template\*0202_40Q0040*Training attendance record form*.xlsm
Set Cell_attendance = GetSheetWithCodename("Sheet1", fichier_A_ouvrir_Attendance_form).Range("A1:U59")
ElseIf shFrom.CodeName = "Feuil5" Then 'Individual attendance forms
Set Cell_attendance = GetSheetWithCodename("Feuil1", fichier_A_ouvrir_Attendance_form).Range("A1:U59")
End If

Cell_attendance.Range("E5").Value = "******************************TEST*******************"

Or avec ce bout de code, je ne peux pas écrire dans le fichier tout juste ouvert que j'utilise comme une template, afin de remplir les cellules qui vont bien pour pouvoir l'imprimer et l'exporter en PDF.

Je suis capable de faire ca si j'ai mon onglet dans le même fichier, mais pas si l'onglet en question est situé dans un fichier à part (et j'aimerais bien le mettre à part, sinon le fichier ou j'ai toutes mes macros, va très vite devenir une vraie usine à gaz).

Merci d'avance si vous pouviez m'aider.

David

Le 10/09/2018 à 15:58

Bonjour,

Bien sûr que tu peux écrire directement dans n'importe quel classeur ouvert dans la même instance de l'application !

Ton code étant incomplet il ne permet pas de cerner l'opération réalisée...

NB- Ta variable shFrom est inutile : double emploi avec sheet_From fournie en argument...

Par contre curCell n'est pas déclarée (ni typée donc)...

Cordialement.

Le 10/09/2018 à 16:15

Oui, j'ai mis les portions de ce qui m'avait semblé être utile à la compréhension du schmilblic

J'ai déclaré ma variable sans soucis, c'est le "copier-gourrer" qui m'a foutu dedans.

Je ne comprend pas pourquoi tu dis que le code est incomplet, c'est peut être justement parce qu'il manque quelque chose que je n'y arrive pas ?

La ou j'hésite et je ne suis pas sur d'avoir bien saisi les nuances ce sont les parties ou je set Cell_attendance, car c'est la même routine que j'utilise pour lire un fichier extérieur avec un vblookup qui fonctionne bien (peut être un pb au niveau de la déclaration du range ?)

Si je commente ce code :

Déclaration du fichier destination (celui à écrire à l'intérieur et ouverture de celui ci)

Set fic_A_ouvrir_Attendance_form = Application.Workbooks.Open(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & fichier_A_ouvrir, True)

En fonction de la feuille d'appel dans mon fichier source, je vais choisir un onglet différent dans le fichier destination :

If shFrom.CodeName = "Feuil3" Then
Set Cell_attendance = GetSheetWithCodename("Sheet1", fichier_A_ouvrir_Attendance_form).Range("A1:U59")
ElseIf shFrom.CodeName = "Feuil5" Then 'Individual attendance forms
Set Cell_attendance = GetSheetWithCodename("Feuil1", fichier_A_ouvrir_Attendance_form).Range("A1:U59")
End If

Test de l'écriture d'une valeur au hasard dans le cellule choisie dans le fichier destination :

Cell_attendance.Range("E5").Value = "******************************TEST*******************"

Function GetSheetwithcodename :

Function GetSheetWithCodename(ByVal worksheetCodename As String, Optional wb As Workbook) As Worksheet

    Dim iSheet As Long
    If wb Is Nothing Then Set wb = ThisWorkbook ' mimics the default behaviour
    For iSheet = 1 To wb.Worksheets.Count
        If wb.Worksheets(iSheet).CodeName = worksheetCodename Then
            Set GetSheetWithCodename = wb.Worksheets(iSheet)
            Exit Function
        End If
    Next iSheet
End Function

Je ne sais pas si ma demande est plus claire comme ceci ?

Le reste de la macro, va juste faire des opérations de copie/collage dans mon fichier source, je pense que c'est inutile de rajouter le code ici ?

Quand tu dis que le code est incomplet, tu veux dire que pour l'opération que je souhaite réaliser, il manque des choses ?

Sur les exemples que j'ai trouvé sur le forum, j'avais l'impression que tout le monde utilisait le nom (caption) de l'onglet au lieu d'utiliser le codename (ce que je souhaite éviter), mais j'ai pas eu l'impression d'avoir oublié un truc par rapport à ce que j'ai compris/vu.

Merci pour tes/vos lumières.

Le 10/09/2018 à 18:17

Re,

Reprenons !

1) On ne sait pas quelle procédure appelle ta procédure export_2days_training, on ne sait donc pas dans quel contexte elle est lancée...

2) Tu testes l'argument Worksheet de la procédure pour initialiser curCell... qui n'est plus réutilisée ensuite ???

Et tu refais le même test ensuite pour initialiser Cell_attendance. Un seul test aurait dû à priori suffire, mais on ne dispose pas de tous les éléments...

3) Entre ces deux tests tu ouvres un fichier en l'affectant à une variable Workbook... sauf que fichier_A_ouvrir n'a pas été initialisée, sa valeur est donc : "". Je ne vois donc pas quel fichier tu peux ouvrir ???

4) GetSheetWithCodename est une procédure appelée avec deux arguments (Function qui renvoie un objet Worksheet). On peut voir ce qu'elle fait puisque tu la cites.

En l'absence de classeur affecté à ta variable lors de la commande d'ouverture, tu envoies Nothing à ta fonction, et elle va te renvoyer une feuille de ton propre classeur dans laquelle tu vas tenter d'écrire...

C'est donc peut-être là que se situe le problème : la variable comportant le nom du classeur à ouvrir n'étant pas initialisée, aucun classeur n'est ouvert... ?

Cordialement.

Le 10/09/2018 à 18:42

bonjour

salut au passage MFerrand

Excel n'a pas besoin de VBA, ni pour lire ni pour écrire entre fichiers.

de simples = suffisent.

note : faire des copies d'un à un autre c'est imiter le papier et le crayon. Excel est au-dessus de ça.

Le 10/09/2018 à 21:24

Bonjour JMD,

j'ai pensé naturellement aux macros, car je souhaite réutiliser des infos dynamiques pour copier toujours dans les mêmes cellules, de mon master, afin d'avoir une template qui me permette de simplement faire du publipostage.

Pour MFerrand, ci dessous tu trouvera la macro complète, qui répondra à toutes tes questions, les variables sont bien initialisées ou tout du moins c'est ce dont je suis sur, mais maintenant comme j'ai pas retouché à ce code depuis plusieurs semaines et que je n'ai pas eu le temps de le commenter vraiment bien, il y a peut être une ligne qui m'échappe :

Sub Button4_Click()

export_2days_training Feuil5

End Sub

Sub export_2days_training(sheet_From As Worksheet)
Dim shFrom As Worksheet, newWst As Worksheet
Dim sh_Attendance As Worksheet
Dim curCell As Range, cell_To_update As Range, cell_Autre_fichier As Range
Dim Cell_attendance As Range
Dim X As Integer, Y As Integer, Z As Integer, ZA As Integer
Dim tab_Jour1(71) As String
Dim tab_Jour2(71) As String
Dim imPression As Boolean
Dim Fichier_pdf As String
Dim date_Jour(3) As String
Dim fichier_A_ouvrir As String
Dim fichier_A_chercher_ouvrir As Workbook
Dim fichier_A_ouvrir_Attendance_form As Workbook
Dim param_attendance_form(5) As String
Dim CheminSource As String

'**************************************
'Optimiser la vitesse d'execution, ne pas activer l'affichage à chauqe routine!
Application.ScreenUpdating = False

'**********************************************
'Permet de réafficher l'onglet Export_2_days_ago pour éviter les problèmes lors de la génération !
Sheet1.Visible = xlSheetVisible

'initialisation des parametres
For X = 0 To 5
param_attendance_form(X) = ""
Next X

Set shFrom = sheet_From

If shFrom.CodeName = "Feuil3" Then
   Set curCell = shFrom.Range("D5")
ElseIf shFrom.CodeName = "Feuil5" Then
   Set curCell = shFrom.Range("D5")
End If

'50250202_40W0002-A BPE COM TRAINING MATRIX.xlsm

'MsgBox (sheet_From.CodeName)
'Exit Sub

'definition jusqu'à quelle colonne on va vérifier la date
'27 cellules pour le theoritical
'72 pour le handson (tableau commence de 0 donc pour ca que le chiffre est 26 et 71 !)
If sheet_From.CodeName = "Feuil3" Then
   Y = 50
   ZA = 26
ElseIf sheet_From.CodeName = "Feuil5" Then
   Y = 310
   ZA = 71
End If

'reinitiliastion du tableau
'tableau de 64 entrées pour être compatible avec le handson schedule
For X = 0 To 71
   tab_Jour1(X) = ""
   tab_Jour2(X) = ""
Next X

'initialise Z
Z = 0

'initialise date jour
date_Jour(0) = ""
date_Jour(1) = ""

'Routine de déplacement à partir de la colone C5 vers la droite sur la ligne 5 pour vérifier chaque date et voir si elle correspond à la date du jour
For X = 0 To Y
   If curCell.Offset(0, X).Value = Date + 1 Then

   'en fonction du jour on va remplir la liste des cellules de chaque module pour le jour1 et le jour2
      If Weekday(curCell.Offset(0, X).Value) = vbSaturday Then
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X + 2).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 3).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 3), "00") & "-" & Format(Month(Date + 3), "00") & "-" & Format(Day(Date + 3), "00")
         date_Jour(1) = Format(Year(Date + 4), "00") & "-" & Format(Month(Date + 4), "00") & "-" & Format(Day(Date + 4), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 3, vbMonday), , vbMonday) & " " & Format(Day(Date + 3), "00") & " " & MonthName(Month(Date + 3), False) & " " & Format(Year(Date + 3), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 4, vbMonday), , vbMonday) & " " & Format(Day(Date + 4), "00") & " " & MonthName(Month(Date + 4), False) & " " & Format(Year(Date + 4), "00")

      ElseIf Weekday(curCell.Offset(0, X).Value) = vbFriday Then
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 3).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 1), "00") & "-" & Format(Month(Date + 1), "00") & "-" & Format(Day(Date + 1), "00")
         date_Jour(1) = Format(Year(Date + 4), "00") & "-" & Format(Month(Date + 4), "00") & "-" & Format(Day(Date + 4), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 1, vbMonday), , vbMonday) & " " & Format(Day(Date + 1), "00") & " " & MonthName(Month(Date + 1), False) & " " & Format(Year(Date + 1), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 4, vbMonday), , vbMonday) & " " & Format(Day(Date + 4), "00") & " " & MonthName(Month(Date + 4), False) & " " & Format(Year(Date + 4), "00")

      ElseIf Weekday(curCell.Offset(0, X).Value) = vbSunday Then
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X + 1).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 2).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 2), "00") & "-" & Format(Month(Date + 2), "00") & "-" & Format(Day(Date + 2), "00")
         date_Jour(1) = Format(Year(Date + 3), "00") & "-" & Format(Month(Date + 3), "00") & "-" & Format(Day(Date + 3), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 2, vbMonday), , vbMonday) & " " & Format(Day(Date + 2), "00") & " " & MonthName(Month(Date + 2), False) & " " & Format(Year(Date + 2), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 3, vbMonday), , vbMonday) & " " & Format(Day(Date + 3), "00") & " " & MonthName(Month(Date + 3), False) & " " & Format(Year(Date + 3), "00")

      Else
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 1).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 1), "00") & "-" & Format(Month(Date + 1), "00") & "-" & Format(Day(Date + 1), "00")
         date_Jour(1) = Format(Year(Date + 2), "00") & "-" & Format(Month(Date + 2), "00") & "-" & Format(Day(Date + 2), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 1, vbMonday), , vbMonday) & " " & Format(Day(Date + 1), "00") & " " & MonthName(Month(Date + 1), False) & " " & Format(Year(Date + 1), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 2, vbMonday), , vbMonday) & " " & Format(Day(Date + 2), "00") & " " & MonthName(Month(Date + 2), False) & " " & Format(Year(Date + 2), "00")

      End If

   End If
Next X

'Date non trouvée dans la feuille !
If date_Jour(0) = "" Then
   MsgBox ("La date du jour n'a pas été trouvée dans l'onglet " & sheet_From.Name & ", vérifiez les dates des training par rapport à la date du jour")
   'Permet de recacher la Sheet1 (Export 2 days ago)
    Sheet1.Visible = xlSheetHidden
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   Exit Sub
End If

'MsgBox (date_Jour(0) & vbCrLf & date_Jour(1) & vbCrLf & date_Jour(2) & vbCrLf & date_Jour(3) & vbCrLf & MonthName(Month(Date + 2), False) & vbCrLf & Format(Month(Date + 2), "00")) & vbCrLf & Str(Date + 2)

'****************Debut de création de la page "Export_2_days_ago" pour l'export***********
'créer une nouvelle feuille
Sheet1.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set newWst = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

'**********************************
'Ne plus afficher les alertes genre overwrite un fichier sur un autre !
Application.DisplayAlerts = False

'****************************************************
'Creation du répertoire au début de la procedure
CheminSource = ThisWorkbook.Path
  On Error Resume Next
  MkDir CheminSource & "\" & "99_training_2d_ago"
  On Error GoTo 0

'*******************************************
'Creation de la boite de dialogue pour demander si on veut imprimer les fiches
'en plus de l export
If MsgBox("Voulez vous imprimer les fiches de résultat en plus de les exporter en PDF ?", vbYesNo, "Demande de confirmation") = vbYes Then
        imPression = True
        Else
        imPression = False
End If

'**************** Routine pour ouvrir le fichier **********************************************
'dans cette partie je vais chercher le fichier training matrix, pour pouvoir l'ouvrir et ainsi chercher les informations dans l'onglet
'Description and timeschedule pour remplir les noms des modules !
'je vais faire une recherche du nom de fichier avec des wildcards comme le nom du fichier peut changer à cause des modifs de noims de projet (4790 Wilton, 5025 Kemsley etc..)

fichier_A_ouvrir = Dir(ThisWorkbook.Path & "\" & "*training matrix*.xlsm")
Set fichier_A_chercher_ouvrir = Application.Workbooks.Open(ThisWorkbook.Path & "\" & fichier_A_ouvrir, True)
Set cell_Autre_fichier = GetSheetWithCodename("Sheet2", fichier_A_chercher_ouvrir).Range("A34:B125")

'Ouvrir le fichier template training attendance form
fichier_A_ouvrir = Dir(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & "*0202_40Q0040*.xlsm")
'MsgBox ("Fichier à ouvrir : " & fichier_A_ouvrir)

'REMPLISSAGE DES SHEETS ATTENDANCES FORMS*******************************
'En fonction de si l_appel vient du classroom training onglet (Feuil3), dans ce cas, j'ouvre le fichier, je me pose sur l'onglet groupe_attendance form = Sheet1
'Si handson appelé, dans ce cas la, c'est l'onglet individual attendance form qui sera utilisé = Feuil1 !

Set fic_A_ouvrir_Attendance_form = Application.Workbooks.Open(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & fichier_A_ouvrir, True)
If shFrom.CodeName = "Feuil3" Then
'Ici le but c est d aller définir sh_attendance sur le range de l onglet group attendance form = Sheet1 du fichier
'..\10_Attendance_Sheet_Template\*0202_40Q0040*Training attendance record form*.xlsm
Set Cell_attendance = GetSheetWithCodename("Sheet1", fichier_A_ouvrir_Attendance_form).Range("A1:U59")
ElseIf shFrom.CodeName = "Feuil5" Then 'Individual attendance forms
Set Cell_attendance = GetSheetWithCodename("Feuil1", fichier_A_ouvrir_Attendance_form).Range("A1:U59")
End If

Cell_attendance.Range("E5").Value = "******************************TEST*******************"

'***************************************  VLOOKUP  **********  VLOOKUP  **********************************
'Vlookup est très capricieux, quelle que soit la configuration de la cellule dans excel (texte ou nombre ou general), lorsque
'la cellule contient un chiffre entier, il ne faut pas mettre la valeur à rechercher entre guillemets !
'quand c'est unchiffre avec une lettre il faut mettre les guillemets"
'quand c'est un chiffre avec virgule ou point (4.1 ou 4,1) il faut le considérer comme un texte donc mettre les guillemets !
'MsgBox (IsNumeric(6) & vbCrLf & IsNumeric("4.1"))
'On Error Resume Next
'MsgBox Application.VLookup(tab_Jour1(0), sheet_From.Range("A37:B52"), 2, False)
'On Error Resume Next
'MsgBox Application.VLookup(CInt(tab_Jour1(0)), sheet_From.Range("A37:B52"), 2, False)

'Set cell_To_update = newWst.Range("Date_export_2_days")
'cell_To_update.Offset(0, 0).Value = Date + 1 + Y

'MsgBox date_Jour(0) & vbCrLf & date_Jour(1) & vbCrLf & date_Jour(2) & vbCrLf & date_Jour(3)

'création de l'export j'ai juste besoin de 2 car 2 jours d'export*****************************
'Jour1
With newWst
   'copier les valeurs
   'offset(ROW, COLUMN)
   ' A gauche la feuille sur laquelle on veut copier
   '/ à droite liste des valeurs

   'JOUR1 / JOUR2
   For Y = 0 To 1

      'en cas d'erreur il passe à l'instruction suivante
      On Error Resume Next

      .Range("Date_export_2_days").NumberFormat = "@"
      .Range("Date_export_2_days").Value = date_Jour(Y + 2)

      'Jour 1
      If Y = 0 Then

      '*******************Début de routine pour export 2days ago jour 1 page 1 Classroom************
         Set cell_To_update = newWst.Range("C7")
         'symbloise la première page classroom
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour1(X) <> "" And tab_Jour1(X) <> "11" And tab_Jour1(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X)

               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X), sheet_From.Range("A37:B52"), 2, False)
               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour1(X)), sheet_From.Range("A37:B52"), 2, False)

            '********Recherche des paramètres pour l'export vers la attendance form********

            '*******Fin de la recherche des paramètres pour la attendance form************

            End If

            Next X
        '*******************Fin de routine pour export 2days ago jour 1 page 1 Classroom************

        '*******************Début de routine pour export 2days ago jour 1 page 1 Handson************
         'symbloise la première page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour1(X) <> "" And tab_Jour1(X) <> "11" And tab_Jour1(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X)

               If IsError(Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour1(X)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)
               End If

            End If
            Next X
        '*******************Fin de routine pour export 2days ago jour 1 page 1 Handson************

         End If
      '*******************Début de routine pour export 2days ago jour 1 page 2 Classroom************
         'symbloise la 2ème page classroom
         Set cell_To_update = newWst.Range("C50")
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour1(X + 36) <> "" And tab_Jour1(X + 36) <> "11" And tab_Jour1(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X + 36)

               If IsError(Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X + 36), sheet_From.Range("A37:B52"), 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X + 36), sheet_From.Range("A37:B52"), 2, False)
               End If
            End If

            Next X
      '*******************Fin de routine pour export 2days ago jour 1 page 2 Classroom************

      '*******************Début de routine pour export 2days ago jour 1 page 2 Handson************
      'symbloise la 2ème page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour1(X + 36) <> "" And tab_Jour1(X + 36) <> "11" And tab_Jour1(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X + 36)

               If IsError(Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour1(X + 36)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X + 36), cell_Autre_fichier, 2, False)
               End If

            End If

            Next X
      '*******************Fin de routine pour export 2days ago jour 1 page 2 Handson************
         End If

      'Jour 2
      ElseIf Y = 1 Then

         Set cell_To_update = newWst.Range("C7")
      '*******************Début de routine pour export 2days ago jour 2 page 1 Classroom************

         'symbloise la première page classroom
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour2(X) <> "" And tab_Jour2(X) <> "11" And tab_Jour2(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X)

               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X), sheet_From.Range("A37:B52"), 2, False)
               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour2(X)), sheet_From.Range("A37:B52"), 2, False)
            End If

            Next X
      '*******************Fin de routine pour export 2days ago jour 2 page 1 Classroom************

      '*******************Début de routine pour export 2days ago jour 2 page 1 Handson************
         'symbloise la première page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour2(X) <> "" And tab_Jour2(X) <> "11" And tab_Jour2(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X)

               If IsError(Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour2(X)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)
               End If

            End If
            Next X
      '*******************Fin de routine pour export 2days ago jour 2 page 1 handson************

         End If

      '*******************Début de routine pour export 2days ago jour 2 page 2 Classroom************
         'symbloise la 2ème page classroom
         Set cell_To_update = newWst.Range("C50")
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour2(X + 36) <> "" And tab_Jour2(X + 36) <> "11" And tab_Jour2(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X + 36)

               If IsError(Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X + 36), sheet_From.Range("A37:B52"), 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X + 36), sheet_From.Range("A37:B52"), 2, False)
               End If
            End If
      '*******************Fin de routine pour export 2days ago jour 2 page 2 Classroom************

            Next X

        '*******************Début de routine pour export 2days ago jour 2 page 2 handson************
         'symbloise la 2ème page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour2(X + 36) <> "" And tab_Jour2(X + 36) <> "11" And tab_Jour2(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X + 36)

               If IsError(Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour2(X + 36)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X + 36), cell_Autre_fichier, 2, False)
               End If

            End If

            Next X
         End If
      '*******************Fin de routine pour export 2days ago jour 2 page 2 handson************
      End If

'*************************************************************
      'imprimer la feuille avec printout
      If imPression = True Then
'***********************************************************
       'Reglages des paramètres de la page
       .PageSetup.PrintArea = "$A$1:$E$86" ' zone impression
'        .Orientation = xlLandscape
       .PageSetup.Orientation = xlPortrait
       .PageSetup.Zoom = False
       .PageSetup.FitToPagesWide = 1
       .PageSetup.FitToPagesTall = False
'       .BlackAndWhite = True ' Noir et Blanc

      .PrintOut , Collate:=True
      End If

      '****************************************************************
      'Export au format PDF, avec overwrtie automatique des fichier pour le 2days_ago
      Fichier_pdf = ThisWorkbook.Path & "\" & "99_training_2d_ago\" & date_Jour(Y) & " - Training Schedule.pdf"
       .ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=Fichier_pdf, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=False

      On Error GoTo 0

   Next Y

End With

      '****************************************************************
      'Export au format PDF, avec overwrtie automatique des fichier pour le attendance form
      Fichier_pdf = ThisWorkbook.Path & "\" & "99_training_2d_ago\" & date_Jour(Y) & " - Training attendance.pdf"

      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False

      'MsgBox (Fichier_pdf)

    'ERREUR SUR CETTE PARTIE**********************  
     sh_Attendance.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=Fichier_pdf, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=False

      On Error GoTo 0

Application.ScreenUpdating = True
Application.DisplayAlerts = True
fichier_A_chercher_ouvrir.Close

Application.ScreenUpdating = False
Application.DisplayAlerts = False

newWst.Delete
shFrom.Activate

Set shFrom = Nothing
Set curCell = Nothing
Set newWst = Nothing
Set cell_To_update = Nothing
Set cell_Autre_fichier = Nothing
Set fichier_A_chercher_ouvrir = Nothing
Set fic_A_ouvrir_Attendance_form = Nothing
Set sh_Attendance = Nothing

'Permet de recacher la Sheet1 (Export 2 days ago)
Sheet1.Visible = xlSheetHidden

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Comme tu peux le voir, l'appel à la procédure export_2days_training, est simplement réalisé via un bouton sur 2 onglets différents du fichier, donc c'est une simple "redirection" qui dit d'où cela vient (il y a peut-être plus simple ou plus pro mais plus complexe, mais cette solution m'allait bien tant que cela fonctionne ).

Donc pour répondre au point 2 : Je réutilise curCell un peu plus loin

Pour le point 3 : J'ai bien le fichier dans la variable, j'ai confirmé avec le msgbox commenté, j'ai bien tout le chemin qui est correct.

Et pour le point 1 j'ai indiqué la réponse juste au dessus.

Ce sera probablement plus simple d'y voir plus clair maintenant

Merci

Le 11/09/2018 à 02:20

Ouf ! Là on s'éloigne vraiment d'une programmation modulaire !

Il va déjà me falloir trouver le temps de simplement la lire, et ce n'est pas ce soir... On verra donc demain.

Bonne soirée.

Le 11/09/2018 à 10:15

Re

j'ai trouvé une coquille que j'ai corrigé mais je viens de voir que je n'ai plus d'erreur à cet endroit mais ca n'est toujours pas bon.

En fait le soucis auquel je suis confronté, c'est que je n'arrive pas à écrire dans le fichier tout juste ouvert, il m'écrit systématiquement dans le sheet du même nom du fichier excel source et non pas dans celui destination.

Voiçi la nouvelle version de la macro :

Sub export_2days_training(sheet_From As Worksheet)
Dim shFrom As Worksheet, newWst As Worksheet
Dim sh_Attendance As Worksheet
Dim curCell As Range, cell_To_update As Range, cell_Autre_fichier As Range
Dim Cell_attendance As Range
Dim X As Integer, Y As Integer, Z As Integer, ZA As Integer
Dim tab_Jour1(71) As String
Dim tab_Jour2(71) As String
Dim imPression As Boolean
Dim Fichier_pdf As String
Dim date_Jour(3) As String
Dim fichier_A_ouvrir As String
Dim fichier_A_chercher_ouvrir As Workbook
Dim fichier_A_ouvrir_Attendance_form As Workbook
Dim param_attendance_form(5) As String
Dim CheminSource As String

'**************************************
'Optimiser la vitesse d'execution, ne pas activer l'affichage à chauqe routine!
Application.ScreenUpdating = False

'**********************************************
'Permet de réafficher l'onglet Export_2_days_ago pour éviter les problèmes lors de la génération !
Sheet1.Visible = xlSheetVisible

'initialisation des parametres
For X = 0 To 5
param_attendance_form(X) = ""
Next X

Set shFrom = sheet_From

If shFrom.CodeName = "Feuil3" Then
   Set curCell = shFrom.Range("D5")
ElseIf shFrom.CodeName = "Feuil5" Then
   Set curCell = shFrom.Range("D5")
End If

'50250202_40W0002-A BPE COM TRAINING MATRIX.xlsm

'MsgBox (sheet_From.CodeName)
'Exit Sub

'definition jusqu'à quelle colonne on va vérifier la date
'27 cellules pour le theoritical
'72 pour le handson (tableau commence de 0 donc pour ca que le chiffre est 26 et 71 !)
If sheet_From.CodeName = "Feuil3" Then
   Y = 50
   ZA = 26
ElseIf sheet_From.CodeName = "Feuil5" Then
   Y = 310
   ZA = 71
End If

'reinitiliastion du tableau
'tableau de 64 entrées pour être compatible avec le handson schedule
For X = 0 To 71
   tab_Jour1(X) = ""
   tab_Jour2(X) = ""
Next X

'initialise Z
Z = 0

'initialise date jour
date_Jour(0) = ""
date_Jour(1) = ""

'Routine de déplacement à partir de la colone C5 vers la droite sur la ligne 5 pour vérifier chaque date et voir si elle correspond à la date du jour
For X = 0 To Y
   If curCell.Offset(0, X).Value = Date + 1 Then

   'en fonction du jour on va remplir la liste des cellules de chaque module pour le jour1 et le jour2
      If Weekday(curCell.Offset(0, X).Value) = vbSaturday Then
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X + 2).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 3).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 3), "00") & "-" & Format(Month(Date + 3), "00") & "-" & Format(Day(Date + 3), "00")
         date_Jour(1) = Format(Year(Date + 4), "00") & "-" & Format(Month(Date + 4), "00") & "-" & Format(Day(Date + 4), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 3, vbMonday), , vbMonday) & " " & Format(Day(Date + 3), "00") & " " & MonthName(Month(Date + 3), False) & " " & Format(Year(Date + 3), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 4, vbMonday), , vbMonday) & " " & Format(Day(Date + 4), "00") & " " & MonthName(Month(Date + 4), False) & " " & Format(Year(Date + 4), "00")

      ElseIf Weekday(curCell.Offset(0, X).Value) = vbFriday Then
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 3).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 1), "00") & "-" & Format(Month(Date + 1), "00") & "-" & Format(Day(Date + 1), "00")
         date_Jour(1) = Format(Year(Date + 4), "00") & "-" & Format(Month(Date + 4), "00") & "-" & Format(Day(Date + 4), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 1, vbMonday), , vbMonday) & " " & Format(Day(Date + 1), "00") & " " & MonthName(Month(Date + 1), False) & " " & Format(Year(Date + 1), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 4, vbMonday), , vbMonday) & " " & Format(Day(Date + 4), "00") & " " & MonthName(Month(Date + 4), False) & " " & Format(Year(Date + 4), "00")

      ElseIf Weekday(curCell.Offset(0, X).Value) = vbSunday Then
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X + 1).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 2).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 2), "00") & "-" & Format(Month(Date + 2), "00") & "-" & Format(Day(Date + 2), "00")
         date_Jour(1) = Format(Year(Date + 3), "00") & "-" & Format(Month(Date + 3), "00") & "-" & Format(Day(Date + 3), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 2, vbMonday), , vbMonday) & " " & Format(Day(Date + 2), "00") & " " & MonthName(Month(Date + 2), False) & " " & Format(Year(Date + 2), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 3, vbMonday), , vbMonday) & " " & Format(Day(Date + 3), "00") & " " & MonthName(Month(Date + 3), False) & " " & Format(Year(Date + 3), "00")

      Else
         While Z <= ZA

         tab_Jour1(Z) = curCell.Offset(Z + 1, X).Value
         tab_Jour2(Z) = curCell.Offset(Z + 1, X + 1).Value

         Z = Z + 1
         Wend

         date_Jour(0) = Format(Year(Date + 1), "00") & "-" & Format(Month(Date + 1), "00") & "-" & Format(Day(Date + 1), "00")
         date_Jour(1) = Format(Year(Date + 2), "00") & "-" & Format(Month(Date + 2), "00") & "-" & Format(Day(Date + 2), "00")
         date_Jour(2) = WeekdayName(Weekday(Date + 1, vbMonday), , vbMonday) & " " & Format(Day(Date + 1), "00") & " " & MonthName(Month(Date + 1), False) & " " & Format(Year(Date + 1), "00")
         date_Jour(3) = WeekdayName(Weekday(Date + 2, vbMonday), , vbMonday) & " " & Format(Day(Date + 2), "00") & " " & MonthName(Month(Date + 2), False) & " " & Format(Year(Date + 2), "00")

      End If

   End If
Next X

'Date non trouvée dans la feuille !
If date_Jour(0) = "" Then
   MsgBox ("La date du jour n'a pas été trouvée dans l'onglet " & sheet_From.Name & ", vérifiez les dates des training par rapport à la date du jour")
   'Permet de recacher la Sheet1 (Export 2 days ago)
    Sheet1.Visible = xlSheetHidden
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   Exit Sub
End If

'MsgBox (date_Jour(0) & vbCrLf & date_Jour(1) & vbCrLf & date_Jour(2) & vbCrLf & date_Jour(3) & vbCrLf & MonthName(Month(Date + 2), False) & vbCrLf & Format(Month(Date + 2), "00")) & vbCrLf & Str(Date + 2)

'****************Debut de création de la page "Export_2_days_ago" pour l'export***********
'créer une nouvelle feuille
Sheet1.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set newWst = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

'**********************************
'Ne plus afficher les alertes genre overwrite un fichier sur un autre !
Application.DisplayAlerts = False

'****************************************************
'Creation du répertoire au début de la procedure
CheminSource = ThisWorkbook.Path
  On Error Resume Next
  MkDir CheminSource & "\" & "99_training_2d_ago"
  On Error GoTo 0

'*******************************************
'Creation de la boite de dialogue pour demander si on veut imprimer les fiches
'en plus de l export
If MsgBox("Voulez vous imprimer les fiches de résultat en plus de les exporter en PDF ?", vbYesNo, "Demande de confirmation") = vbYes Then
        imPression = True
        Else
        imPression = False
End If

'**************** Routine pour ouvrir le fichier **********************************************
'dans cette partie je vais chercher le fichier training matrix, pour pouvoir l'ouvrir et ainsi chercher les informations dans l'onglet
'Description and timeschedule pour remplir les noms des modules !
'je vais faire une recherche du nom de fichier avec des wildcards comme le nom du fichier peut changer à cause des modifs de noims de projet (4790 Wilton, 5025 Kemsley etc..)

fichier_A_ouvrir = Dir(ThisWorkbook.Path & "\" & "*training matrix*.xlsm")
Set fichier_A_chercher_ouvrir = Application.Workbooks.Open(ThisWorkbook.Path & "\" & fichier_A_ouvrir, True)
Set cell_Autre_fichier = GetSheetWithCodename("Sheet2", fichier_A_chercher_ouvrir).Range("A34:B125")

'Ouvrir le fichier template training attendance form
fichier_A_ouvrir = Dir(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & "*0202_40Q0040*.xlsm")
'MsgBox ("Fichier à ouvrir : " & fichier_A_ouvrir)

'REMPLISSAGE DES SHEETS ATTENDANCES FORMS*******************************
'En fonction de si l_appel vient du classroom training onglet (Feuil3), dans ce cas, j'ouvre le fichier, je me pose sur l'onglet groupe_attendance form = Sheet1
'Si handson appelé, dans ce cas la, c'est l'onglet individual attendance form qui sera utilisé = Feuil1 !

Set fic_A_ouvrir_Attendance_form = Application.Workbooks.Open(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & fichier_A_ouvrir, True)
If shFrom.CodeName = "Feuil3" Then
'Ici le but c est d aller définir sh_attendance sur le range de l onglet group attendance form = Sheet1 du fichier
'..\10_Attendance_Sheet_Template\*0202_40Q0040*Training attendance record form*.xlsm
Set Cell_attendance = GetSheetWithCodename("Sheet1", fichier_A_ouvrir_Attendance_form).Range("A1")
ElseIf shFrom.CodeName = "Feuil5" Then 'Individual attendance forms

'Set Cell_attendance = GetSheetWithCodename("Feuil1", fichier_A_ouvrir_Attendance_form).Range("A1")
Set sh_Attendance = fic_A_ouvrir_Attendance_form.CodeName = Feuil1
Set Cell_attendance = sh_Attendance.Range("A1")

End If

Cell_attendance.Offset(5, 5).Value = "******************************TEST*******************"

'***************************************  VLOOKUP  **********  VLOOKUP  **********************************
'Vlookup est très capricieux, quelle que soit la configuration de la cellule dans excel (texte ou nombre ou general), lorsque
'la cellule contient un chiffre entier, il ne faut pas mettre la valeur à rechercher entre guillemets !
'quand c'est unchiffre avec une lettre il faut mettre les guillemets"
'quand c'est un chiffre avec virgule ou point (4.1 ou 4,1) il faut le considérer comme un texte donc mettre les guillemets !
'MsgBox (IsNumeric(6) & vbCrLf & IsNumeric("4.1"))
'On Error Resume Next
'MsgBox Application.VLookup(tab_Jour1(0), sheet_From.Range("A37:B52"), 2, False)
'On Error Resume Next
'MsgBox Application.VLookup(CInt(tab_Jour1(0)), sheet_From.Range("A37:B52"), 2, False)

'Set cell_To_update = newWst.Range("Date_export_2_days")
'cell_To_update.Offset(0, 0).Value = Date + 1 + Y

'MsgBox date_Jour(0) & vbCrLf & date_Jour(1) & vbCrLf & date_Jour(2) & vbCrLf & date_Jour(3)

'création de l'export j'ai juste besoin de 2 car 2 jours d'export*****************************
'Jour1
With newWst
   'copier les valeurs
   'offset(ROW, COLUMN)
   ' A gauche la feuille sur laquelle on veut copier
   '/ à droite liste des valeurs

   'JOUR1 / JOUR2
   For Y = 0 To 1

      'en cas d'erreur il passe à l'instruction suivante
      On Error Resume Next

      .Range("Date_export_2_days").NumberFormat = "@"
      .Range("Date_export_2_days").Value = date_Jour(Y + 2)

      'Jour 1
      If Y = 0 Then

      '*******************Début de routine pour export 2days ago jour 1 page 1 Classroom************
         Set cell_To_update = newWst.Range("C7")
         'symbloise la première page classroom
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour1(X) <> "" And tab_Jour1(X) <> "11" And tab_Jour1(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X)

               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X), sheet_From.Range("A37:B52"), 2, False)
               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour1(X)), sheet_From.Range("A37:B52"), 2, False)

            '********Recherche des paramètres pour l'export vers la attendance form********

            '*******Fin de la recherche des paramètres pour la attendance form************

            End If

            Next X
        '*******************Fin de routine pour export 2days ago jour 1 page 1 Classroom************

        '*******************Début de routine pour export 2days ago jour 1 page 1 Handson************
         'symbloise la première page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour1(X) <> "" And tab_Jour1(X) <> "11" And tab_Jour1(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X)

               If IsError(Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour1(X)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)
               End If

            End If
            Next X
        '*******************Fin de routine pour export 2days ago jour 1 page 1 Handson************

         End If
      '*******************Début de routine pour export 2days ago jour 1 page 2 Classroom************
         'symbloise la 2ème page classroom
         Set cell_To_update = newWst.Range("C50")
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour1(X + 36) <> "" And tab_Jour1(X + 36) <> "11" And tab_Jour1(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X + 36)

               If IsError(Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X + 36), sheet_From.Range("A37:B52"), 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X + 36), sheet_From.Range("A37:B52"), 2, False)
               End If
            End If

            Next X
      '*******************Fin de routine pour export 2days ago jour 1 page 2 Classroom************

      '*******************Début de routine pour export 2days ago jour 1 page 2 Handson************
      'symbloise la 2ème page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour1(X + 36) <> "" And tab_Jour1(X + 36) <> "11" And tab_Jour1(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour1(X + 36)

               If IsError(Application.VLookup(tab_Jour1(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour1(X + 36)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour1(X + 36), cell_Autre_fichier, 2, False)
               End If

            End If

            Next X
      '*******************Fin de routine pour export 2days ago jour 1 page 2 Handson************
         End If

      'Jour 2
      ElseIf Y = 1 Then

         Set cell_To_update = newWst.Range("C7")
      '*******************Début de routine pour export 2days ago jour 2 page 1 Classroom************

         'symbloise la première page classroom
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour2(X) <> "" And tab_Jour2(X) <> "11" And tab_Jour2(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X)

               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X), sheet_From.Range("A37:B52"), 2, False)
               On Error Resume Next
               cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour2(X)), sheet_From.Range("A37:B52"), 2, False)
            End If

            Next X
      '*******************Fin de routine pour export 2days ago jour 2 page 1 Classroom************

      '*******************Début de routine pour export 2days ago jour 2 page 1 Handson************
         'symbloise la première page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour2(X) <> "" And tab_Jour2(X) <> "11" And tab_Jour2(X) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X)

               If IsError(Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour2(X)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)
               End If

            End If
            Next X
      '*******************Fin de routine pour export 2days ago jour 2 page 1 handson************

         End If

      '*******************Début de routine pour export 2days ago jour 2 page 2 Classroom************
         'symbloise la 2ème page classroom
         Set cell_To_update = newWst.Range("C50")
         If sheet_From.CodeName = "Feuil3" Then
            For X = 0 To 35

            If tab_Jour2(X + 36) <> "" And tab_Jour2(X + 36) <> "11" And tab_Jour2(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X + 36)

               If IsError(Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X + 36), sheet_From.Range("A37:B52"), 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X + 36), sheet_From.Range("A37:B52"), 2, False)
               End If
            End If
      '*******************Fin de routine pour export 2days ago jour 2 page 2 Classroom************

            Next X

        '*******************Début de routine pour export 2days ago jour 2 page 2 handson************
         'symbloise la 2ème page handson
         ElseIf sheet_From.CodeName = "Feuil5" Then
            For X = 0 To 35

            If tab_Jour2(X + 36) <> "" And tab_Jour2(X + 36) <> "11" And tab_Jour2(X + 36) <> "13" Then
               cell_To_update.Offset(X, 0).Value = tab_Jour2(X + 36)

               If IsError(Application.VLookup(tab_Jour2(X), cell_Autre_fichier, 2, False)) = True Then
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(CInt(tab_Jour2(X + 36)), cell_Autre_fichier, 2, False)
               Else
                  On Error Resume Next
                  cell_To_update.Offset(X, 0 + 1).Value = Application.VLookup(tab_Jour2(X + 36), cell_Autre_fichier, 2, False)
               End If

            End If

            Next X
         End If
      '*******************Fin de routine pour export 2days ago jour 2 page 2 handson************
      End If

'*************************************************************
      'imprimer la feuille avec printout
      If imPression = True Then
'***********************************************************
       'Reglages des paramètres de la page
       .PageSetup.PrintArea = "$A$1:$E$86" ' zone impression
'        .Orientation = xlLandscape
       .PageSetup.Orientation = xlPortrait
       .PageSetup.Zoom = False
       .PageSetup.FitToPagesWide = 1
       .PageSetup.FitToPagesTall = False
'       .BlackAndWhite = True ' Noir et Blanc

      .PrintOut , Collate:=True
      End If

      '****************************************************************
      'Export au format PDF, avec overwrtie automatique des fichier pour le 2days_ago
      Fichier_pdf = ThisWorkbook.Path & "\" & "99_training_2d_ago\" & date_Jour(Y) & " - Training Schedule.pdf"
       .ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=Fichier_pdf, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=False

      On Error GoTo 0

   Next Y

End With

      '****************************************************************
      'Export au format PDF, avec overwrtie automatique des fichier pour le attendance form
      Fichier_pdf = ThisWorkbook.Path & "\" & "99_training_2d_ago\" & date_Jour(Y) & " - Training attendance.pdf"

      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False

      'MsgBox (Fichier_pdf)

     sh_Attendance.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=Fichier_pdf, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=False

      On Error GoTo 0

Application.ScreenUpdating = True
Application.DisplayAlerts = True
fichier_A_chercher_ouvrir.Close

Application.ScreenUpdating = False
Application.DisplayAlerts = False

newWst.Delete
shFrom.Activate

Set shFrom = Nothing
Set curCell = Nothing
Set newWst = Nothing
Set cell_To_update = Nothing
Set cell_Autre_fichier = Nothing
Set fichier_A_chercher_ouvrir = Nothing
Set fic_A_ouvrir_Attendance_form = Nothing
Set sh_Attendance = Nothing

'Permet de recacher la Sheet1 (Export 2 days ago)
Sheet1.Visible = xlSheetHidden

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Et ici voici la partie corrigée extraite de la macro prinicipale :

Set fic_A_ouvrir_Attendance_form = Application.Workbooks.Open(ThisWorkbook.Path & "\10_Attendance_Sheet_Template\" & fichier_A_ouvrir, True)
If shFrom.CodeName = "Feuil3" Then
Set Cell_attendance = GetSheetWithCodename("Sheet1", fichier_A_ouvrir_Attendance_form).Range("A1")
ElseIf shFrom.CodeName = "Feuil5" Then 'Individual attendance forms

'Set Cell_attendance = GetSheetWithCodename("Feuil1", fichier_A_ouvrir_Attendance_form).Range("A1")
Set sh_Attendance = fic_A_ouvrir_Attendance_form.CodeName = Feuil1
Set Cell_attendance = sh_Attendance.Range("A1")

End If

Cell_attendance.Offset(5, 5).Value = "******************************TEST*******************"

Je ne comprend pas pourtant je pointe bien vers le fichier avec les variables initialisées, la je coince...

Merci pour toute l'aide que vous pourrez m'apporter.

David

Le 13/09/2018 à 02:11

Je viens de terminer la remise en forme de ton code, l'indentation n'étant pas vraiment ton souci , mais il est vrai que cela ne sert que pour ceux qui le lisent dans le but de comprendre ce qui est écrit...

J'avoue que j'hésite à poursuivre, car après réindentation, scission des lignes trop longues pour qu'elles soient visibles sans devoir aller les chercher, suppressions de toutes lignes de commentaires, et toutes lignes vides, on se retrouve avec une procédure de 347 lignes... Certes, beaucoup de lignes inutiles, et un code très répétitif, mais mettre de l'ordre là-dedans ! fait naviguer dans des méandres...

J'ai compté 17 On Error Resume Next ! sans désactivation intermédiaire, au surplus dans des boucles (pour être sûr qu'il soit activé quelques centaines de fois ! )

Sache qu'un gestionnaire d'erreur est actif, une fois activé tant qu'on ne l'a pas désactivé. Et on évite de l'activer dans une boucle, car une activation suffit.

Une désactivation aussi suffit : là il n'y en a que 2 à suite !

Sache aussi que les variables ont toujours une valeur initiale par défaut, dès lors qu'elle sont déclarées (et même aussi quand elles ne le sont pas), donc il est tout à fait inutile de les initialiser à la valeur qu'elles ont déjà par défaut. C'est perdre son temps et multiplier gratuitement des lignes de codes.

En outre, les variables locales n'ont d'existence que durant l'exécution de la procédure, en fin d'exécution elles disparaissent de la mémoire. Il est donc inutile de les réinitialiser en fin de procédure !

Dans le même ordre d'idée, Application.ScreenUpdating et Application.DisplayAlerts, lorsqu'on les a paramétrés à False, sont automatiquement rétablis par Excel à True en fin de procédure, autant le laisser faire, pas besoin de lui forcer la main !

Et on en fait des réactivations-désactivations à plusieurs reprises au cours de l'exécution ! Cela peut éventuellement se justifier pour la mise à jour de l'affichage (encore qu vu le nombre, la plupart devraient être évités) mais en aucun cas pour les messages d'alerte pour lesquels c'est purement gratuit et sans objet.

Pour la suite des inutilités, il faut entrer plus avant dans le code... Tu auras au moins pu enregistrer quelques rudiments si je renonce à poursuivre...

En tout état de cause, ta ligne citée dans un fragment de code que tu dis avoir rectifié :

Set sh_Attendance = fic_A_ouvrir_Attendance_form.CodeName = Feuil1

devrait normalement déclencher une erreur. Elle ne répond à aucune syntaxe correcte.

Deux = sur la même ligne, ça devrait déjà alerter ! Cela signifie logiquement que ce qui se trouve après le premier signe = constitue une expression booléenne destinée à renvoyer Vrai ou Faux !

Mais ce 2e = compare une expression renvoyant une valeur String (CodeName) à un objet Worksheet (Feuil1).

Le résultat est donc pour le moins incertain, d'autant qu'un comparaison d'objets n'utilise pas = mais l'opérateur Is, et un CodeName n'est de toute façon pas un objet.

Et en tout état de cause, si l'expression renvoyait une valeur, celle-ci ne constitue pas une référence d'objet affectable avec Set.

Il aurait donc été plus utile de tester les variables supposées défaillantes, après leur initialisation de façon à s'assurer de leur contenu.

Cordialement.

Le 13/09/2018 à 08:01

Bonjour MFerrand,

merci pour le temps passé à essayer de lire le code, il y a pleins de chose que j'ignorais sur l'initialisation/libération sous Excel, ca va effectivement simplifier mon code.

Oui pour l'indentation, je ne suis pas aussi bordélique d'habitude mais je dois avouer que sur ce coup tu as raison (pour preuve le début de la procédure).

Je vais creuser du côté du côté du gestionnaire d'erreur, j'avais cru qu'il fallait le placer à chaque endroit.

Pour la ligne avec les 2 égaux, je suis con pour le coup, j'ai du passer 150 fois devant et je ne l'ai pas vu

Il aurait donc été plus utile de tester les variables supposées défaillantes, après leur initialisation de façon à s'assurer de leur contenu.

C'est ce que j'essaye de faire avec les msgbox parsemés un peu partout, par contre je ne sais pas comment tester le genre de variables workksheet et consors, dans le compilateur le résultat est moins parlant qu'avec un string, intéger ou boolean, malheureusement.

Je vais commencer par regarder tous les points soulevés.

Merci

'**************************EDIT*****************************

Wahou, mince alors, je suis en train de trouver une ribambelle de problèmes et il est beaucoup plus rapide, en désactivant/réactivant la gestion des erreurs d'Excel, maintenant je comprends mieux pourquoi je ne comprenais pas et surtout pourquoi tout le monde me dit que mon code est bon à mettre à la poubelle

Encore merci MFerrand.

Je devrais m'en sortir tout seul maintenant (enfin j'espère )

Le 13/09/2018 à 10:50

Bonjour,

Bonne initiative de désactiver les gestions d'erreurs pour y voir clair...

Pour ma part, je n'ai pas dit que ton code était bon à mettre à la poubelle ! J'ai simplement dit que beaucoup de choses pouvaient être supprimées, mais que je n'ai pas toutes énumérées, et qu'il y avait de nombreuses répétitions, soit implicitement qu'il convenait de s'y pencher dans le but de les réduire, soit dans la même procédure, soit en modularisant en diverses procédures (exemple : un code répété quasi identiquement plusieurs fois, peut faire l'objet d'une procédure secondaire qui sera appelée autant de fois que nécessaire par la procédure principale, avec des arguments différents... ainsi on peut parfois arriver à réduire considérablement le volume de code et cela en facilite la maintenance).

Cordialement.

Le 13/09/2018 à 11:39

Non pas de soucis, la pique de mettre à la poubelle le code, venait d'un autre intervenant, sur un autre fil, j'ai simplement fait un paralèlle, je ne te visais pas du tout, même si c'est pas tout à fait faux non plus (mauvais code).

Le 13/09/2018 à 15:37
dav999 a écrit :

Bonjour JMD,

j'ai pensé naturellement aux macros, car je souhaite réutiliser des infos dynamiques pour copier toujours dans les mêmes cellules, de mon master, afin d'avoir une template qui me permette de simplement faire du publipostage.

re à tous

une macro pour faire du publipostage ?

encore plus étrange...

Rechercher des sujets similaires à "ecrire fichier"