Rappatriement de fichiers, si ko s'arrête prématurément

Le 11/12/2012 à 15:31

Bonjour,

J'ai une procédure qui concataine les données de 3 fichiers pour toutes les feuilles demandées par ListBox.

Les feuilles ont toutes le même nom, pour les 3 fichiers ; ce nom correspond à la codification mm-aa.

La listbox reprend donc toutes les feuilles possibles sur une période (2 ans).

La procédure ouvre chacun des fichiers et rappatrie les données cochées dans la listebox.

Donc si on veut récupérer dans le dossier de destination, à travaers la listbox le données 09-12, 11-12, 12-12 et que l'on a dans les fichiers Source1 09-12, 11-12, 12-12, Source2 11-12, 12-12 et Source3 09-12, 12-12.

je récupère dans ma destination : 09-12 seulement pour Source1 KO, il manque la source3, 11-12 pour Source1 et Source 2 OK, 12-12 pour les 3 sources (OK).

D'ailleurs, pendant le déroulement de la procédure, je ne reçois pas le message :

"Le mois " & Me.LtB_Feuil.List(I) & " n'a pas été créé dans le classeur " & WbSource.Name

pour Source3 09-12.

Voici la fonction utilisée

Function FeuilleExiste(Classeur As String, Feuille As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Workbooks(Classeur).Sheets(Feuille).Name <> ""
  On Error GoTo 0
End Function

et la procédure de rappatriement :

Private Sub CmbOk_Click()
      Dim I As Integer
      Dim WbSource As Workbook, WbDestin As Workbook        ' Variables des fichiers à coller sur le destinataire
      Dim DerLgPE As Byte, DerLgPC As Byte, DerLgPO As Byte   'Récup des Tablos des données
      Dim objImg As Object, Emplacement As Range, Fichier As String      'Récup de l'image dans l'entête

'Traitement de la liste
10      For I = 0 To Me.LtB_Feuil.ListCount - 1     'pour toute la liste des tablos à récupérer possibles
20        If Me.LtB_Feuil.Selected(I) = True Then Exit For  'si la sélection est possible sortir du Pour
30      Next I
40      If I = Me.LtB_Feuil.ListCount Then      'si aucune sélection n'est faite
50        MsgBox "Rien de sélectionné"
60        Exit Sub
70      End If

80      Application.ScreenUpdating = False

90      Set WbDestin = ThisWorkbook

        'RAPPATRIEMENT DU PREMIER FICHIER AVEC ENTETE & SOMMAIRE ACTIVITE
         Application.DisplayAlerts = False

100     Set WbSource = Workbooks.Open(ThisWorkbook.Path & "\planning missions PC V4_3.xlsm")
110     For I = 0 To Me.LtB_Feuil.ListCount - 1
120       If Me.LtB_Feuil.Selected(I) = True Then
            'utilisation de la fonction Existe sur la source
130         If FeuilleExiste(WbSource.Name, Me.LtB_Feuil.List(I)) = True Then
      '           WbSource.Sheets(Me.LtB_Feuil.List(I)).Cells.FormatConditions.Delete     ' Evite la recopie du format conditionnel
140           If FeuilleExiste(WbDestin.Name, Me.LtB_Feuil.List(I)) = False Then
150             WbDestin.Sheets.Add after:=WbDestin.Sheets(WbDestin.Sheets.Count)
160             WbDestin.Sheets(WbDestin.Sheets.Count).Name = Me.LtB_Feuil.List(I)
170           End If

              ' Copie de l'entête avec les formats largeurs
180           WbSource.Sheets(Me.LtB_Feuil.List(I)).Range("B2:AG4").Copy

190           WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("B2").PasteSpecial Paste:=xlPasteColumnWidths
200           WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("B2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
210           WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("B2").PasteSpecial Paste:=xlPasteFormats
              'Largeur des colonnes A et AH
220           WbDestin.Sheets(WbDestin.Sheets.Count).Range("A:A").ColumnWidth = 3.5
230           WbDestin.Sheets(WbDestin.Sheets.Count).Range("AH:AH").ColumnWidth = 3.5
              'Insertion de l'image en B2
240           Fichier = "F:\AT Missions\Livraisons\Réunion.jpg"
250           Set objImg = WbDestin.Sheets(Me.LtB_Feuil.List(I)).Pictures.Insert(Fichier)
260           Set Emplacement = WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("B2")
270           Set objImg = WbDestin.Sheets(Me.LtB_Feuil.List(I)).DrawingObjects(WbDestin.Sheets(Me.LtB_Feuil.List(I)).Shapes.Count)
280             With objImg.ShapeRange
290                 .LockAspectRatio = msoFalse
300                 .Left = Emplacement.Left        'Position Gauche
310                 .Top = Emplacement.Top          'Position Haute
320                 .Height = Emplacement.Height    'Position Base
                '    .Width = Emplacement.Width     'Position sur la cellule
330                 .Width = 45   'Largeur
340             End With

              ' Copie du Planning
350           WbSource.Sheets(Me.LtB_Feuil.List(I)).Activate
360           DerLgPC = Range("B15").End(xlDown).Row
            '  Copie de la liste des Activités avec les couleurs MFC
370           WbSource.Sheets(Me.LtB_Feuil.List(I)).Range("AI7:AK45").Copy WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("AI7")
            '  Copie de la liste des jours FERIES / MFC
'            WbSource.Sheets(Me.LtB_Feuil.List(I)).Range("FT15:FT40").Copy WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("FT15")
380           WbSource.Sheets(Me.LtB_Feuil.List(I)).Range("A15:AG" & DerLgPC).Copy WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("A5")
390           DerLgPC = DerLgPC - 10
400           WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("A5:A" & DerLgPC) = "PC"
410         Else
420           MsgBox "Le mois " & Me.LtB_Feuil.List(I) & " n'a pas été créé dans le classeur " & WbSource.Name
430         End If
440       End If
450     Next I
460     WbSource.Close savechanges:=False

        'RAPPATRIEMENT DU DEUXIEME FICHIER AVEC SEULEMENT LES DONNEES

480     Set WbSource = Workbooks.Open(ThisWorkbook.Path & "\planning missions PE V4_3.xlsm")
490     For I = 0 To Me.LtB_Feuil.ListCount - 1
500       If Me.LtB_Feuil.Selected(I) = True Then
510         If FeuilleExiste(WbSource.Name, Me.LtB_Feuil.List(I)) = True Then
      '500           WbSource.Sheets(Me.LtB_Feuil.List(I)).Cells.FormatConditions.Delete     ' Evite la recopie du format conditionnel
520           If FeuilleExiste(WbDestin.Name, Me.LtB_Feuil.List(I)) = False Then
530             WbDestin.Sheets.Add after:=WbDestin.Sheets(WbDestin.Sheets.Count)
540             WbDestin.Sheets(WbDestin.Sheets.Count).Name = Me.LtB_Feuil.List(I)
550           End If

              ' Copie du Planning
560           WbSource.Sheets(Me.LtB_Feuil.List(I)).Activate
570           DerLgPE = Range("B15").End(xlDown).Row
580           WbSource.Sheets(Me.LtB_Feuil.List(I)).Range("A15:AG" & DerLgPE).Copy WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("A" & DerLgPC + 2)
590           DerLgPE = DerLgPC + DerLgPE - 13
600           WbDestin.Sheets(Me.LtB_Feuil.List(I)).Range("A" & DerLgPC + 2 & ":A" & DerLgPE) = "PE"  '
610         Else
620           MsgBox "Le mois " & Me.LtB_Feuil.List(I) & " n'a pas été créé dans le classeur " & WbSource.Name
630         End If
640       End If
650     Next I
660     WbSource.Close savechanges:=False

        'RAPPATRIEMENT DU TROISIEME FICHIER AVEC SEULEMENT LES DONNEES
'dito que pour le rappatriment du 2ème fichier
Application.DisplayAlerts = True
End Sub

Merci de bien vouloir m'aider et m'expliquer le pourquoi des choses.

Le 11/12/2012 à 15:53

Bonjour

Comme cela pas facile à trouver le pourquoi du comment

Je viens de tester le fichier que je t'avais envoyé et pas de soucis, il indique bien les pages manquantes dans les fichiers sources

Peut être que ton fichier et les sources (même vides) aiderait à trouver

Le 12/12/2012 à 08:10

Bonjour Banzai

voilà l'ensemble des fichiers (même l'image ).

Merci de bien vouloir m'aider.

PS : pour lancer la USF, il faut cliquer sur l'image de la feuille Menu (en A1).

Pendant que j'y pense, il me semble avoirs lu qq part, qu'on pouvait lier les fichiers en les collant pour éviter de les supprimer et de les recréer à chaque fois ; ce qui voudrait dire qu'à chaque fois qu'on ouvre le fichier récap, les feuilles déjà crées seraient mise à jour des modifications intervenues entre temps. Ai-je rêvé ou est-ce possible ?

Le 12/12/2012 à 11:42

Bonjour

mouftie a écrit :

D'ailleurs, pendant le déroulement de la procédure, je ne reçois pas le message :

Aucun souci avec le programme que tu as envoyé

J'ai bien les 2 messages 1 pour 9-12 dans PE et l'autre pour 11-12 dans PO

mouftie a écrit :

qu'on pouvait lier les fichiers en les collant pour éviter de les supprimer

Oui mais je ne sais pas comment le mettre en œuvre

Il faut faire collage spécial avec liaisons

Le 12/12/2012 à 11:46

Bonjour Banzai

Banzai64 a écrit :

J'ai bien les 2 messages 1 pour 9-12 dans PE et l'autre pour 11-12 dans PO

Oui, mais il manque dans le fichier récap le 09-12 du PO.

Le 12/12/2012 à 13:33

Bonjour

Voici le résultat que j'obtiens

9-1211-1212-12
PC ligne 5PC ligne 5PC ligne 5
------PE ligne 75PE ligne 75
PO ligne 142------PO ligne 142
Le 12/12/2012 à 14:31

Que j'ai honte ! je ne suis pas allée voir en ligne 140 ...

Je suis vraiment désolée de t'avoir fait perdre ton temps ainsi.

Merci encore.

Rechercher des sujets similaires à "rappatriement fichiers arrete prematurement"