XL 2010 Récupération des données en les transférant avec des tri et enregistrement

Linda42 · 17 Novembre 2020

Bonjour la team Excel,

Je souhaite pouvoir créer une fiche annexe (FA) à partir de données du fichier Presta Spé (FB).

Ce que je veux récupérer en automatique est la plage B132:I237 de FB.

Là ou cela se complique, c'est que je souhaiterais que les éléments soient automatiquement trier par date puis par Prestations Spéciales.

Le fichier qui sera créer (FA)devra être également paramétré pour que l'impression tienne en compte la mise en page suivante :

suppression de la colonne d (qui permettra le trie de tout le tableau et pas seulement les trois premières colonnes)
suppresion de la vba en place concernant le calendrier
ajustement de la largeur des colonnes en fonction du contenu (pas de renvoi à la ligne des cellules)
mise en page Portrait avec ajustement echelle 1 page en largeur sur deux en longueur
centre la page horizontalement
ligne à répeter $1:$6
Pied de page personnalisé à droite avec le numéro de page

Je souhaiterais que ce fichier (FA) soit enregistré directement dans un dossier précis.

J'ai commencé à faire une vba (que j'utilise pour un autre fichier et que j'essaie d'adapter à celui ci) mais je pense qu'il faut le compléter, car cela concerne uniquement l'enregistrement du fichier et en plus je ne maitrise absolument pas les macros mais une belle motivation pour apprendre à les utiliser:

Sub EnregistrementAnnexePrestaInFacture()
'je déclare mes valeurs

Dim NomDossier As String
Dim Chemin As String
'Je nomme le dossier et donne le chemin de sauvegarde

NomDossier = Application.InputBox("ArchivageFactures:", "Année ?")
Chemin = "C:chemin que je préciserais ultérieurement\" & NomDossier & "\"

If NomDossier = "" Then Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypexlsx, Filename:= _
Chemin & "AnnexeFactureMois_" & Range("H132").Value & ".xls", quality:= _
xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
openafterpublish:=False

End Sub

Merci à tous

fanch55 · 19 Novembre 2020

Ci-joint le classeur modifié pour le nom de fichier .
( tu aurais pu le modifier toi-même dans la sub Save_Newbook , variable Dossier )

Linda42 à dit:
Quand j'exécute cette procédure, c'est l'ensemble du fichier qui est exporté dans un nouveau classeur et nom la plage que nous avions défini.

Tu as probablement exécuté la Sub Save_Newbook seule ...
En fait, le module était constitué de 3 Subs .

Du coup, j'ai ré-intégré le save_newbook dans le run_export.

Pour faire ce que tu demandes, il faut exécuter
la sub Test_Export qui appelle la sub Run_Export
Par défaut, cette dernière traite tout ce qui est en dessous et à droite de la cellule B132, donc ta plage que tu pourras éventuellement...

ChTi160 · 17 Novembre 2020

Bonjour Linda

pas évident tout ça Lol
une première proposition qui concerne le tri de la plage "B137 à I237"

VB:

With Worksheets("Modèle") 'avec la feuille Ici Modèle
 DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B137 à I237"
  DerCol = .Cells(137, 100).End(xlToLeft).Column ' dernière colonne de la plage "B137 à I237"
    With .Range(.Cells(137, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie
      .Sort key1:=.Cells(1, 1), order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Header:=xlYes 'On trie par dates d'abord puis par prestations
    End With
End With

Bonne Journée
jean marie

Linda42 · 17 Novembre 2020

ChTi160 à dit:

Bonjour Linda

pas évident tout ça Lol
une première proposition qui concerne le tri de la plage "B137 à I237"

VB:

With Worksheets("Modèle") 'avec la feuille Ici Modèle
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B137 à I237"
  DerCol = .Cells(137, 100).End(xlToLeft).Column ' dernière colonne de la plage "B137 à I237"
    With .Range(.Cells(137, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie
      .Sort key1:=.Cells(1, 1), order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Header:=xlYes 'On trie par dates d'abord puis par prestations
    End With
End With

Bonne Journée
jean marie

Bonjour,
Merci M. Le retraité chanceux ;-), c'est déjà un super début.

Cdt

Linda42 · 17 Novembre 2020

ChTi160 à dit:

Bonjour Linda

pas évident tout ça Lol
une première proposition qui concerne le tri de la plage "B137 à I237"

VB:

With Worksheets("Modèle") 'avec la feuille Ici Modèle
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B137 à I237"
  DerCol = .Cells(137, 100).End(xlToLeft).Column ' dernière colonne de la plage "B137 à I237"
    With .Range(.Cells(137, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie
      .Sort key1:=.Cells(1, 1), order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Header:=xlYes 'On trie par dates d'abord puis par prestations
    End With
End With

Bonne Journée
jean marie

Re,
J'ai copié votre vba dans le module et en lançant l'exécution, le tri n'est pas fait :

Sub CreerClasseur()

'Étape 1: Copier des données
Sheets("Feuil1").Range("B132:I237").Copy
'Etape 2: Créez un nouveau classeur
Workbooks.Add
'Étape 3: collez les données
ActiveSheet.Paste Destination:=Range("A1")
'Étape 4: Désactivez le message d'alerte
Application.DisplayAlerts = False
'Étape 5: Enregistrez la feuille de calcul nouvellement créée
ActiveWorkbook.SaveAs _
Filename:="C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe1_FactureMois_" & Range("G1")
'Étape 6: Activer les messages d'alerte
Application.DisplayAlerts = True

With Worksheets("Feuil") 'avec la feuille Ici Modèle
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B132 à I237"
DerCol = .Cells(132, 100).End(xlToLeft).Column 'dernière colonne de la plage "B132 à I237"
With .Range(.Cells(132, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Header:=xlYes 'On trie par dates d'abord puis par prestations
End With

End With
End Sub

Pour le moment, le problème que je rencontre est à l'étape 5, lorsque j'exécute, j'ai bien un fichier qui se crée mais pas d'enregistrement auto (message d'erreur qui m'indique que le chemin d'accès n'existe pas)
Ce que j'ai voulu faire c'est désigner le chemin d'acces et enregistrer le document sous le nom Annexe1_FactureMois_ avec un report du texte qui se trouve sur ce fichier en G1 (cela devrait donner Annexe1_FactureMois_Septembre etc....)

Et en ce qui concerne votre vba, le tri ne fonctionne pas non plus.

Une idée?

fanch55 · 18 Novembre 2020

Bonsoir,
A tester :

VB:

Sub Test_Export()

    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range

    Set WsScr = Worksheets(ActiveSheet.Name) ' a adapter a vos besoins
    Set MaPlage = WsScr.Range("B132:I237")

    Application.SheetsInNewWorkbook = 1
    Application.Workbooks.Add

    Set WsDest = Worksheets(ActiveSheet.Name)
    MaPlage.Copy WsDest.Range("A1")
    With WsDest
        .[G1] = WsScr.[C1]
        .Columns("D").Delete
        .Columns("A:G").ColumnWidth = 100
        .Columns("A:G").AutoFit
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A7:A106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("C7:C106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A6:G106")
            .Header = xlYes
            .Apply
        End With
        Application.PrintCommunication = False
        With .PageSetup
            .PaperSize = xlPaperA4:         .Orientation = xlPortrait
            .PrintTitleRows = "$1:$6":      .RightFooter = "&P/&N"
            .CenterHorizontally = True:     .Zoom = False
            .FitToPagesWide = 1:            .FitToPagesTall = 2
        End With
        Application.PrintCommunication = True
        .PrintPreview
    End With
    Filename = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe1_FactureMois_" & _
        Format([F1], "mmm_yyyy")
       
    On Error Resume Next
        ActiveWorkbook.SaveAs Filename:=Filename
        If Err > 0 Then
            Filename = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=Filename)
       
            If Filename <> False _
            Then  ActiveWorkbook.SaveAs Filename:=Filename
        End If
    On Error GoTo 0
   
    If ActiveWorkbook.Saved Then ActiveWorkbook.Close
       
    ' Libérer mémoire -------------------------------------------------
    Set WsScr = Nothing: Set WsDest = Nothing: Set MaPlage = Nothing
End Sub

Linda42 · 18 Novembre 2020

fanch55 à dit:

Bonsoir,
A tester :

VB:

Sub Test_Export()

    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range

    Set WsScr = Worksheets(ActiveSheet.Name) ' a adapter a vos besoins
    Set MaPlage = WsScr.Range("B132:I237")

    Application.SheetsInNewWorkbook = 1
    Application.Workbooks.Add

    Set WsDest = Worksheets(ActiveSheet.Name)
    MaPlage.Copy WsDest.Range("A1")
    With WsDest
        .[G1] = WsScr.[C1]
        .Columns("D").Delete
        .Columns("A:G").ColumnWidth = 100
        .Columns("A:G").AutoFit
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A7:A106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("C7:C106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A6:G106")
            .Header = xlYes
            .Apply
        End With
        Application.PrintCommunication = False
        With .PageSetup
            .PaperSize = xlPaperA4:         .Orientation = xlPortrait
            .PrintTitleRows = "$1:$6":      .RightFooter = "&P/&N"
            .CenterHorizontally = True:     .Zoom = False
            .FitToPagesWide = 1:            .FitToPagesTall = 2
        End With
        Application.PrintCommunication = True
        .PrintPreview
    End With
    Filename = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe1_FactureMois_" & _
        Format([F1], "mmm_yyyy")
       
    On Error Resume Next
        ActiveWorkbook.SaveAs Filename:=Filename
        If Err > 0 Then
            Filename = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=Filename)
       
            If Filename <> False Then
                On Error Resume Next
                ActiveWorkbook.SaveAs Filename:=Filename
            End If
        End If
    On Error GoTo 0
   
    If ActiveWorkbook.Saved Then ActiveWorkbook.Close
       
    ' Libérer mémoire -------------------------------------------------
    Set WsScr = Nothing: Set WsDest = Nothing: Set MaPlage = Nothing
End Sub

Merci beaucoup, je teste cela demain et je vous fait un retour.
Une question avant, cette vba sera sur un fichier annuelle dans lequel il y a une feuille par mois (soit une feuille modèle, 12 feuilles de Janvier à Décembre et une feuille récap. Je vous ai transférer que la feuille 1 pour évoquer mon problème. Ma question : cette macro sera t elle utilisable sur chacune des feuilles, sachant que les feuilles n'ont pas le même nom?

Merci encore

ChTi160 · 18 Novembre 2020

Bonjour Linda
Bonjour Fanch55
Linda ! ne tienquiete pas c'est Normal Lol
je disais : " pas évident tout ça Lol "
je constate que cela ce confirme Lol
il y'a plein de choses qui font que Lol
1° pourquoi ne pas trier la base de données avant le Transfert ?
2° Tu colles les données sur la "Feuil1" en "A1"

VB:

 ActiveSheet.Paste Destination:=Range("A1")

Ta plage Range("B132:I237") devient donc Range("A1:H106")
Ensuite tu mets

VB:

With Worksheets("Feuil") 'avec la feuille Ici "Modéle"
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B132 à I237"
au lieu de
DerCol = .Cells(132, 100).End(xlToLeft).Column 'dernière colonne de la plage "B132 à I237"
With .Range(.Cells(132, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Header:=xlYes 'On trie par dates d'abord puis par prestations
End With

que représente le "Feuil" dans

With Worksheets("Feuil")

Ensuite tu n'as rien changé dans la procédure de tri
soit :

DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B132 à B237"
au lieu de
.Cells(.Rows.Count,1).End(xlUp).Row 'dernière ligne non Vide de la plage "A1 à Axxxxx"
puis
DerCol = .Cells(132, 100).End(xlToLeft).Column 'dernière colonne de la plage "Ligne 132"
DerCol = .Cells(1, 100).End(xlToLeft).Column 'dernière colonne de la plage " Ligne 1"

donc

With .Range(.Cells(132, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie
devrait être
With .Range(.Cells(1, 1), .Cells(DerLgn, DerCol))

Donc rien ne peut marcher dans ce que je t'avais proposé ! t'inquiète Lol
je laisse Fanch55 traiter cette demande !ma procédure ne peut dans l'état répondre à ta Nouvelle demande!

Ma question : cette macro sera t elle utilisable sur chacune des feuilles, sachant que les feuilles n'ont pas le même nom?

Je pense , que tu aurait du annoncer l ensemble des tenants et aboutissants .
Bonne journée
jean marie

Linda42 · 18 Novembre 2020

ChTi160 à dit:
Bonjour Linda
Bonjour Fanch55
Linda ! ne tienquiete pas c'est Normal Lol
je disais : " pas évident tout ça Lol "
je constate que cela ce confirme Lol
il y'a plein de choses qui font que Lol
1° pourquoi ne pas trier la base de données avant le Transfert ?
2° Tu colles les données sur la "Feuil1" en "A1"

VB:

ActiveSheet.Paste Destination:=Range("A1")

Ta plage Range("B132:I237") devient donc Range("A1:H106")
Ensuite tu mets

VB:

With Worksheets("Feuil") 'avec la feuille Ici "Modéle" DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'dernière ligne non Vide de la plage "B132 à I237" au lieu de DerCol = .Cells(132, 100).End(xlToLeft).Column 'dernière colonne de la plage "B132 à I237" With .Range(.Cells(132, 2), .Cells(DerLgn, DerCol)) 'Avec la plage ainsi définie .Sort key1:=.Cells(1, 1), order1:=xlAscending, Key2:=.Cells(1, 3), Order2:=xlAscending, Header:=xlYes 'On trie par dates d'abord puis par prestations End With

que représente le "Feuil" dans

Ensuite tu n'as rien changé dans la procédure de tri
soit :

donc

Donc rien ne peut marcher dans ce que je t'avais proposé ! t'inquiète Lol
je laisse Fanch55 traiter cette demande !ma procédure ne peut dans l'état répondre à ta Nouvelle demande!

Je pense , que tu aurait du annoncer l ensemble des tenants et aboutissants .
Bonne journée
jean marie[/Code]

Merci Jean Marie,
Oui effectivement, j'aurais du précisé ce détail important dès le début mais je n'y ai pas pensé et surtout je pensais que la sélection des plages serait sur la feuille active, et ainsi j'aurais pu affecter la macro avec un bouton de contrôle que j'aurais créer sur chaque page.
En tout cas je me note la vba que tu proposes pour un éventuel besoin moins compliqué que cette demande et je te remercie pour ton aide.
Cdt

Linda42 · 18 Novembre 2020

fanch55 à dit:

Bonsoir,
A tester :

VB:

Sub Test_Export()

    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range

    Set WsScr = Worksheets(ActiveSheet.Name) ' a adapter a vos besoins
    Set MaPlage = WsScr.Range("B132:I237")

    Application.SheetsInNewWorkbook = 1
    Application.Workbooks.Add

    Set WsDest = Worksheets(ActiveSheet.Name)
    MaPlage.Copy WsDest.Range("A1")
    With WsDest
        .[G1] = WsScr.[C1]
        .Columns("D").Delete
        .Columns("A:G").ColumnWidth = 100
        .Columns("A:G").AutoFit
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A7:A106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("C7:C106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A6:G106")
            .Header = xlYes
            .Apply
        End With
        Application.PrintCommunication = False
        With .PageSetup
            .PaperSize = xlPaperA4:         .Orientation = xlPortrait
            .PrintTitleRows = "$1:$6":      .RightFooter = "&P/&N"
            .CenterHorizontally = True:     .Zoom = False
            .FitToPagesWide = 1:            .FitToPagesTall = 2
        End With
        Application.PrintCommunication = True
        .PrintPreview
    End With
    Filename = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe1_FactureMois_" & _
        Format([F1], "mmm_yyyy")
       
    On Error Resume Next
        ActiveWorkbook.SaveAs Filename:=Filename
        If Err > 0 Then
            Filename = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=Filename)
       
            If Filename <> False Then
                On Error Resume Next
                ActiveWorkbook.SaveAs Filename:=Filename
            End If
        End If
    On Error GoTo 0
   
    If ActiveWorkbook.Saved Then ActiveWorkbook.Close
       
    ' Libérer mémoire -------------------------------------------------
    Set WsScr = Nothing: Set WsDest = Nothing: Set MaPlage = Nothing
End Sub

fanch55 à dit:

Bonsoir,
A tester :

VB:

Sub Test_Export()

    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range

    Set WsScr = Worksheets(ActiveSheet.Name) ' a adapter a vos besoins
    Set MaPlage = WsScr.Range("B132:I237")

    Application.SheetsInNewWorkbook = 1
    Application.Workbooks.Add

    Set WsDest = Worksheets(ActiveSheet.Name)
    MaPlage.Copy WsDest.Range("A1")
    With WsDest
        .[G1] = WsScr.[C1]
        .Columns("D").Delete
        .Columns("A:G").ColumnWidth = 100
        .Columns("A:G").AutoFit
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A7:A106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("C7:C106"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A6:G106")
            .Header = xlYes
            .Apply
        End With
        Application.PrintCommunication = False
        With .PageSetup
            .PaperSize = xlPaperA4:         .Orientation = xlPortrait
            .PrintTitleRows = "$1:$6":      .RightFooter = "&P/&N"
            .CenterHorizontally = True:     .Zoom = False
            .FitToPagesWide = 1:            .FitToPagesTall = 2
        End With
        Application.PrintCommunication = True
        .PrintPreview
    End With
    Filename = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe1_FactureMois_" & _
        Format([F1], "mmm_yyyy")
       
    On Error Resume Next
        ActiveWorkbook.SaveAs Filename:=Filename
        If Err > 0 Then
            Filename = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=Filename)
       
            If Filename <> False Then
                On Error Resume Next
                ActiveWorkbook.SaveAs Filename:=Filename
            End If
        End If
    On Error GoTo 0
   
    If ActiveWorkbook.Saved Then ActiveWorkbook.Close
       
    ' Libérer mémoire -------------------------------------------------
    Set WsScr = Nothing: Set WsDest = Nothing: Set MaPlage = Nothing
End Sub

Bonjour,

J'ai testé et cela semble bien répondre à mon besoin, et notamment l'utiliser pour chaque feuille active, je l'ai copié dans un module.
Il y a qq bugs tout de même :
- parfois certaines données ne sont pas récupérer, je pense que c'est lié aux formules (parfois avec des liaisons). Pouvons nous appliquer une copie uniquement des valeurs et du format (sans les formules); d'ailleurs cela devrait régler, j'espère, un autre problème qui est que le nom de sauvegarde ne récupère pas le texte de F1, résultat à l'enregistrement des fichiers s'appelant tous Annexe1_FactureMois_ , la création d'u fichier écrase donc ceux déjà enregistré.
- pouvons nous supprimer de la copie le calendrier (bouton contrôle)

Si, non à part cela, tous me semble correct et je te remercie sincèrement pour ton aide.

Dans l'attente de te lire.
Cdt

ChTi160 · 18 Novembre 2020

Re
Tu dis :

la création d'u fichier écrase donc ceux déjà enregistré.

Il faudra mais fanch55 va y remédier
Derterminer pour chaque feuille mois la ligne a partir de laquelle coller la plage B132:I237
Ex:

VB:

With WsDest
Ligne_Cible = . Cells(.Rows.Count,1).End(xlUp).Row+1
MaPlage.Copy .Range("A"& Ligne_Cible)
.[G1] etc ,etc

Non testé pas d'ordi(téléphone)
Jean marie

fanch55 · 18 Novembre 2020

Mouture corrigée + commentaires .
Attention, il semblerait que les colonnes du tableau ne soient pas uniformes dans leur police et taille .

Classeur supprimé, voir le post #14

ChTi160 · 18 Novembre 2020

Re
merci fanch55
arff !
j'avais encore rien compris Lol
jean marie

Linda42 · 18 Novembre 2020

fanch55 à dit:
Mouture corrigée + commentaires .
Attention, il semblerait que les colonnes du tableau ne soient pas uniformes dans leur police et taille .

Merci beaucoup, c'est parfait.

J'ai tenter de rajouter qq mais je ne suis vraiment pas douée.

J'ai une macro qui permet d'ouvrir une boite de dialogue pour demander dans quelle dossier enregistrer le document.
Je voulais récupérer l'application Inputbox mais avec "AnnexeFactures", "Année?")
Est-ce que tu pourrais m'intégrer cette dernière étape ?

Pour info, ci-dessous la vba que je tente d'adapter

VB:

Sub EnregistrementFacture()
 'je déclare mes valeurs

Dim NomDossier As String
Dim Chemin As String
'Je nomme le dossier et donne le chemin de sauvegarde

NomDossier = Application.InputBox("ArchivageFactures:", "Année ?")
Chemin = "C:\Users\linda\OneDrive\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\ArchivageFactures\" & NomDossier & "\"

If NomDossier = "" Then Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypexlsx, Filename:= _
Chemin & "FactureNumero_" & Range("H2").Value & ".pdf", quality:= _
xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
 openafterpublish:=False
 

End Sub

Un grand merci en tout cas pour ton aide précieuse
Cdt

fanch55 · 18 Novembre 2020

fanch55 à dit:
Attention, il semblerait que les colonnes du tableau ne soient pas uniformes dans leur police et taille .

Mouture corrigée: les formats des lignes du tableau sont écrasés avec ceux de la première ligne .
(uniformisation des lignes)

fanch55 · 18 Novembre 2020

Linda42 à dit:

VB:

Sub EnregistrementFacture()
.....
.....
ActiveSheet.ExportAsFixedFormat Type:=xlTypexlsx, Filename:= _
Chemin & "FactureNumero_" & Range("H2").Value & ".pdf", quality:= _
xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
openafterpublish:=False

End Sub

Un grand merci en tout cas pour ton aide précieuse
Cdt

En fait, cela n'a rien à voir avec la demande initiale,
ce que tu désires faire en plus , c'est exporter le nouveau classeur en PDF ?
Faut-il continuer à l'enregistrer en xlsx quand même ?

XL 2010 Récupération des données en les transférant avec des tri et enregistrement

Linda42

XLDnaute Occasionnel

fanch55

ChTi160

XLDnaute Barbatruc

Linda42

XLDnaute Occasionnel

Linda42

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Linda42

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Linda42

XLDnaute Occasionnel

Linda42

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Linda42

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

Discussions similaires