XL 2010 Copie de données spécifiques vers Feuille export

[jeanba]

Bonjour le Forum,

Je peine à faire marcher cette macro (voir ci-joint):

- je copie les données de la feuille sélectionnée à partir d'une userform parmi les feuilles du classeur Source à copier vers Feuille export
- je les copie dans une feuille appelée Feuille export, à partir de la ligne 4
- je sauvegarde sous pdf la feuille source
- j'appelle ensuite la procédure Inventaire

Il y a certainement un souci quelque part, mais j'ignore où

Merci par avance

Jeanba

 

[jeanba]

PS:
- le classeur Feuille export doit s'enregistrer après écriture et se fermer.
- le classeur Inventaire doit également se fermer après traitement

Merci encore

 

[jeanba]

Bonjour à tous,

Quelqu'un a-t-il une idée de la raison pour laquelle cette macro (voir post 1) ne marche pas s'il vous plaît?

Voici l'algo:

Option Explicit

Dim WbData As Workbook         ' WbData = Classeur de données source
Dim WbExp As Workbook          ' WbExp = Classeur destinataire
Dim ShData As Worksheet           ' ShData = Feuille du classeur de données source, sélectionné sur l'userform 08
Dim ShExpP As Worksheet           ' ShExpP = Feuille du classeur destinataire nommé "PARAMETRES"
Dim ShExpD As Worksheet          ' ShExpD = Feuille du classeur destinataire nommé "DONNEES"
Dim mois, i&

' *********************************

Private Sub USF08_CommandButton1_Click()
    Unload Me
End Sub

' ************************************

Private Sub USF08_CommandButton2_Click()
    Application.ScreenUpdating = False
    mois = (Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", _
            "Décembre"))

    For i = 1 To 12
        If Me.Controls("USF08_OptionButton" & i).Value = True Then
            Set ShData = WbData.Sheets(mois(i - 1))
            DeverrouillerFeuille
            On Error GoTo OuvrirFichier
            Set ShExpP = WbExp.Sheets("PARAMETRES")
            Set ShExpD = WbExp.Sheets("DONNEES")
            ShExpP.Range("B2") = ShData.Range("A7")
            ShExpD.Range("A4").CurrentRegion.Offset(1, 0).ClearContents
            ShData.Range("A8:C" & ShData.Range("A" & Rows.Count).End(xlUp).Row).Copy
            ShExpD.Range("A4").PasteSpecial xlPasteValues
            ShData.Range("E8:H" & ShData.Range("A" & Rows.Count).End(xlUp).Row).Copy
            ShExpD.Range("D4").PasteSpecial xlPasteValues
            Exit For
        End If
    Next i
    ShData.Copy
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\Sauvegarde Journal " & Format(i, "00") & " " & WbExp.Range("parametres!B2") & ".pdf"
    ActiveWindow.Close False
    WbExp.Close
    Unload Me
    Application.CutCopyMode = False
    MsgBox "Génération du Fichier Comptable: " & Chr(13) & Chr(10) & "Etape 1: Export des données du mois exécutée à 100%!"
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventaire.xlsm"
Exit Sub
OuvrirFichier:
    MsgBox "Vous devez ouvrir le fichier ''Feuille export.xlsm''", 16
    Unload Me
End Sub

'*******************************************

Private Sub UserForm_Initialize()
    Set WbData = ActiveWorkbook
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Feuille export.xlsm"
    Set WbExp = ActiveWorkbook
    WbData.Activate
End Sub

Merci beaucoup!

Jeanba

 

[sousou]

bonjour
quelques remarques
Commence par supprimer on error afin de voir les erreurs potentiel.
la procedure déverouille n'existe a s alors Met un ' devant deverouille ou crée cette procédure.
ShData.Copy va te créé un nouveau classeur, parcequ'il n'y à pas de destination

 

[jeanba]

Bonjour sousou,

Merci pour cette réaction rapide.
J'ai suivi ton conseil. Il bloque maintenance sur la procédure d'enregistrement sous pdf de la feuille source.
Et en désactivant cette instruction, il s'exécute, mais sans fermer le fichier destinaitaire.
J'ai comme l'impression qu'il y a un souci dans ma procédure d'initialisation de l'userforme:

Private Sub UserForm_Initialize()

    Set WbData = ActiveWorkbook
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Feuille export.xlsm"
    Set WbExp = ActiveWorkbook
    WbData.Activate
End Sub

Car, je ne manipule pas bien les Set WbData et WbExp. Je veux dire, le fait qu'à la fois l'un et l'autre sont = ActiveWorkbook ne pose pas de problème?

 

[sousou]

ta remarques est juste, mais avant il faudrait définir exactement ton copier coller dans la feuille export, dans un nouveau classeur
quelles données au juste.

 

[jeanba]

OK.
Mais, vu mes limites, c'est possible que tu regardes directement sur les fichiers joints ce que j'ai expliqué dans le 1er post s'il te plaît?

 

[sousou]

Voici une version qui va peut-être correspondre à ce que tu cherches, mais tes explication sont bien sommaires
N'oublie jamais que nous ne connaissons pas ton contexte......
J'ai corriger les erreurs grossières sur l'utilisation des variable de classeurs
Pa besoin d'activer un classeur à tout moment quan il est définit dans une variable, il suffit d'appeler la variable

 

[jeanba]

Bonsoir sousou,

Tu viens de m'offrir un sacré cadeau de fin d'année! Ca marche enfin! Merci infiniment!
D'accord pour tes remarques, je m'efforcerai d'en tenir compte;

Par contre, une des choses que j'ai pas remarqué de suite, est que si la feuille ShData à sauvegarder (oui, y avait une petite confusion effectivement, car dans ton fichier, c'est plutôt Feuille export qui s'imprimait sous pdf), alors oui je parlais de la feuille ShData. Si cette contient des lignes vides, ce serait dommage de la sauvegarder telle qu'elle. J'ai donc nécessairement besoin d'insérer une procédure qui masque les lignes vides. Et, après copie et sauvegarde sous pdf, j'appelle la procédure qui affiche à nouveau les lignes précédemment masquées.

J'ai testée ces 2 procédures, elles fonctionnent. Maintenant, je suis perdu pour ce qui est de savoir à quels niveaux les placer dans ton code pour que:

• avant de copier les données, il n'y ait plus de lignes vides
• après copie et sauvegarde sous pdf, les lignes vides reviennent

Voic mon code qui fait tout sauf Masquer/Afficher les lignes comme souhaité..:

Private Sub USF08_CommandButton2_Click()
Set WbExp = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Feuille export.xlsm")
    Application.ScreenUpdating = False
    mois = (Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", _
            "Décembre"))

    For i = 1 To 12
        If Me.Controls("USF08_OptionButton" & i).Value = True Then
            Set ShData = WbData.Sheets(mois(i - 1))
            Set ShExpP = WbExp.Sheets("PARAMETRES")
            Set ShExpD = WbExp.Sheets("DONNEES")
            
'          Ici, j'ai cru pouvoir insérer ma procédure pour Masquer les lignes
            With WbData.Sheets(mois(i - 1))
                .Visible = True
                MasquerLignesVides
            End With
            
            ShExpP.Range("B2") = ShData.Range("A7")
            ShExpD.Range("A4").CurrentRegion.ClearContents
            ShData.Range("A8:C" & ShData.Range("A" & Rows.Count).End(xlUp).Row).Copy
            ShExpD.Range("A4").PasteSpecial xlPasteValues
            ShData.Range("E8:H" & ShData.Range("A" & Rows.Count).End(xlUp).Row).Copy
            ShExpD.Range("D4").PasteSpecial xlPasteValues
            

            With WbData.Sheets(mois(i - 1))
                AfficherLignes
                .Visible = False
            End With
            
            mmois = i
            
            Exit For
        End If
    Next i
    nom = ThisWorkbook.Path & "\Sauvegarde Journal " & Format(mmois, "00") & " " & WbData.Sheets("parametres").Range("B2") & ".pdf"

    'A moins que ce soit ici qu'il faudrait plutôt la placer?

    WbData.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nom  'C'est ici que j'ai apporté la modif concernant la feuille à sauvegarder sous pdf
    WbExp.Close savechanges:=False
    Application.CutCopyMode = False
    Unload Me
    MsgBox "Génération du Fichier Comptable: " & Chr(13) & Chr(10) & "Etape 1: Export des données du mois exécutée à 100%!"
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventaire.xlsm"
Exit Sub
OuvrirFichier:
    MsgBox "Vous devez ouvrir le fichier ''Feuille export.xlsm''", 16
End Sub

Les procédures qui Masque/Affiche les lignes:

Sub AfficherLignes()
If Cells(232 - 7, 1).EntireRow.Hidden = True Then
    Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A2").Select
End If
End Sub


Sub MasquerLignesVides()
Dim cel As Range
Dim sht As Worksheet
If ActiveSheet.Name <> "ACCUEIL" Then
'    DeverrouillerFeuille
    For Each cel In Range("A8:A232")
        If cel.Value = "" Then
             cel.EntireRow.Hidden = True
        End If
    Next
End If
End Sub

Merci

 

[sousou]

Essai comme ceci
For i = 1 To 12
If Me.Controls("USF08_OptionButton" & i).Value = True Then
Set ShData = WbData.Sheets(mois(i - 1))
Call MasquerLignesVides(ShData)
Set ShExpP = WbExp.Sheets("PARAMETRES")
Set ShExpD = WbExp.Sheets("DONNEES")
ShExpP.Range("B2") = ShData.Range("A7")
ShExpD.Range("A4").CurrentRegion.ClearContents
ShData.Range("A8:C" & ShData.Range("A" & Rows.Count).End(xlUp).Row).Copy
ShExpD.Range("A4").PasteSpecial xlPasteValues
ShData.Range("E8:H" & ShData.Range("A" & Rows.Count).End(xlUp).Row).Copy
ShExpD.Range("D4").PasteSpecial xlPasteValues
mmois = i
Exit For
End If
Next i
nom = ThisWorkbook.Path & "\Sauvegarde Journal " & Format(mmois, "00") & " " & WbExp.Sheets("parametres").Range("B2") & ".pdf"
WbExp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nom
WbExp.Close savechanges:=False
Unload Me
Application.CutCopyMode = False
MsgBox "Génération du Fichier Comptable: " & Chr(13) & Chr(10) & "Etape 1: Export des données du mois exécutée à 100%!"
Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventaire.xlsm"
Exit Sub
OuvrirFichier:
MsgBox "Vous devez ouvrir le fichier ''Feuille export.xlsm''", 16
Unload Me
End Sub
Private Sub UserForm_Initialize()
Set WbData = ThisWorkbook

End Sub
Sub MasquerLignesVides(feuille)
Dim cel
For Each cel In feuille.Range("A8:A232")
If cel.Value = "" Then
cel.EntireRow.Hidden = True
End If
Next

End Sub