Résultats pour "enregistrement vba"

9'214 résultats pour cette recherche

Bonjour à tous

Je vais essayer d'être le plus clair possible

J'ai créé un tableau excel intitulé 'tableau vierge"

Des informations sont alors entrées sur ce tableau, la personne doit normalement "enregistrer sous" sous le nom d'un client mais malheureusement il est souvent enregistrer sous mon fameux" tableau vierge".

Ma question est la suivante, comment bloquer le bouton 'enregistrer" mais pas le bouton "enregistrement sous"

Merci d'avance pour vos réponses

A bientôt

Bonjour,

Je souhaite que mon code ouvre la fenêtre "Enregistrer sous" et propose un nom de fichier par défaut qui correspond à la valeur de la cellule A1. Cependant je ne souhaite pas proposer de chemin d'enregistrement.

Malgré plusieurs essais je n'y parviens pas... Auriez-vous une idée?

Merci par avance,

Bonjour,

Je me permets de solliciter la communauté pour m'aider à résoudre un problème sur lequel je bute depuis maintenant plusieurs heures.

Je travail sur la création d'une application d'évaluation de compétences qui sera utilisée par plusieurs utilisateurs sur plusieurs machines.

Lorsque l'utilisateur a terminé, il peut enregistrer le résultat de cette évaluation au format pdf suivant un chemin précis

"C:\Users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4") & "\" & Sheets("Feuil6").Range("K2") & "\"

Mon problème est le suivant tout fonctionne à merveille sur ma tablette surface pro 4.

Mais si je l'utilise sur l'une des surfaces pro 6 du boulot (ce qui sera le cas, l'application est crée pour ça) ça me renvoie une

"erreur d'execution 1004 documents non enregistrés le document peutêtre ouvert ou une erreur s'est produite lors de l'enregistrement."

Je ne comprends pas d'où vient le problème car j'ai justement utilisé environ (username) pour pouvoir utiliser l'appli sur n'importe quelle machine, quelque soit le nom utilisateur (puisque les collègues seront amenés à l'utiliser également).

Les dossiers de destinations sont créés s'ils n'existent pas via ce module bien pratique trouvé sur le net :

Function CreerDossier(Chemin As String)

On Error GoTo CreerDossierErreur

Dim PremierDossier As String

Dim CheminReseau As Boolean

Dim CheminPartielOK As String

Dim CheminPartiel, PartieDeChemin As Integer

Dim PartiesDeChemin As Variant

Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

If Len(Dir(Chemin, vbDirectory)) > 0 Then

CreerDossier = True

Exit Function

Else

'suppression du dernier backslash si présent

If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)

'vérificacion si chemin local ou réseau

If Left(Chemin, 2) = "\\" Then

CheminReseau = True

Else

CheminReseau = False

End If

'décomposition du chemin

If CheminReseau = False Then

PartiesDeChemin = Split(Chemin, Application.PathSeparator)

CheminPartielOK = ""

PremierDossier = LBound(PartiesDeChemin)

Else

PartiesDeChemin = Split(Replace(Chemin, "\\", ""), Application.PathSeparator)

CheminPartielOK = ""

PremierDossier = LBound(PartiesDeChemin) + 1

End If

'tests et créations de (sous)dossiers

For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin)

For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin

If CheminReseau = False Then

CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator

Else

CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator

End If

If CheminPartiel = PartieDeChemin Then

If CheminReseau = False Then

If FSO.FolderExists(CheminPartielOK) = False Then

MkDir CheminPartielOK

End If

Else

If Right(CheminPartielOK, 1) = Application.PathSeparator Then _

CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1)

If Left(CheminPartielOK, 2) <> "\\" Then _

CheminPartielOK = "\\" & CheminPartielOK

If FSO.FolderExists(CheminPartielOK) = False Then

MkDir CheminPartielOK

End If

End If

End If

Next CheminPartiel

CheminPartielOK = ""

Next PartieDeChemin

End If

CreerDossier = True

Exit Function

CreerDossierErreur:

CreerDossier = False

End Function

Sub ExempleCreationDossierAvecSousdossiers()

'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo ExempleErreur

Dim NouveauDossierAvecSousDossiers As String

NouveauDossierAvecSousDossiers = "C:\Users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4").Value & "\" & Sheets("Feuil6").Range("K2").Value

CreerDossier (NouveauDossierAvecSousDossiers)

Exit Sub

ExempleErreur:

MsgBox "Une erreur est survenue..."

End Sub

Et enfin ci après le module avec la ligne pointée par le débogage :

Sub Export_PDF()

'

Dim Répertoire As Variant

Dim Fichier As String

Dim feuille As Variant

Dim Nom As Name

Répertoire = "C:\Users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4") & "\" & Sheets("Feuil6").Range("K2") & "\" 'Dossier de destination des fichiers PDF créés

With Worksheets("Feuil6").Range("G1:S49")

'On donne au fichier PDF le nom de la feuille active

Fichier = Sheets("Feuil6").Range("R4") & "___" & Sheets("Feuil6").Range("H4") & "___" & Format(Date, "dd.mm.yyyy") & ".pdf"

Chemin = Répertoire & Fichier

'On crée le nouveau document au format PDF

.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End With

End Sub

J'ai pas mal cherché sur le net pour des problèmes similaires, j'ai tenté plusieurs choses mais au mieux j'obtiens que ça ne bug pas, sans obtenir l'enregistrement suivant le chemin spécifié... D'avance je vous remercie de votre aide !

cordialement

jb

Bonjour à tous,

Je souhaite créer une macro qui permet de définir le nom d'enregistrement d'un fichier via un formulaire qui apparaît au moment où l'utilisateur clique sur le bouton "Enregistrer sous".

J'ai donc créé un userform et dans "ThisWorkbook" j'ai inséré cette macro :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = False Then Exit Sub Else UserForm1.Show nomFichier = TypeMetier & TypeDocument & Version & ChampLibre Application.Dialogs(xlDialogSaveAs).Show (nomFichier) Exit Sub End If If Cancel = True Then Exit Sub End Sub

Le formulaire n'apparaît donc bien que si l'utilisateur clique sur "enregistrer sous". Le seul soucis c'est que l'utilisateur est obligé de remplir deux fois le formulaire.

Lors du premier appel de la macro, la macro exécute bien la ligne "Application.Dialogs(xlDialogSaveAs).Show (nomFichier)" puis revient en tête de la macro.

Quelqu'un comprend-t-il pourquoi ?

Je vous joint le fichier

Merci et bonne journée,

Maëlle.

Bonjour,

J'ai cette macro qui permets à l'utilisateur de sauvegarder une copie du fichier dans le répertoire de son choix.

J'aimerais qu'un chemin par défaut soit déjà tracé lorsque l'utilisateur arrive sur cette boite de dialogue (mais je ne sais pas comment rajouter cela dans la partie du code qui correspond à l'enregistrement -voir ci-dessous-).

191207063920663431
Sub Reinitialisation_Fichier()
    Dim Nbr As Variant
    Dim AdresseCell As Variant

    Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String, NomComplet As String

    'On fait une sauvegarde du fichier avant réinitialisation
    '.xlsm = 5
    '.xls = 4

    date_archive = Replace(Range("A5").Value, "/", "-")

    wk = ActiveWorkbook.Name
    LeNom = Left(wk, Len(wk) - 5) & " (" & date_archive & ")" & ".xlsm" 'A adapter

        Set objShell = CreateObject("Shell.Application")

recommence:

Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour sauvegarder votre archive.", &H1&)

        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path

            If Chemin = "" Then
            MsgBox "Le répertoire que vous avez choisi n'est pas valide."
            GoTo recommence
            End If

    ActiveWorkbook.SaveCopyAs Chemin & "\" & LeNom   'à adapter

    MsgBox "Une copie de votre classeur a bien été enregistrée dans le répertoire que vous avez choisi." & Chr(10) & Chr(10) & _
    "Le fichier " & ActiveWorkbook.Name & " va maintenant être réinitialisé. Cette opération peut durer quelques minutes."
End Sub

Merci d'avance pour votre aide,

Bapt

Bonjour,

J'ai trouvé ce code pour enregistrer en PDF sur mon bureau. Je rencontrer un bogue quand je réponds "oui" à la question "Faut-il l'écraser ?".

Savez-vous pourquoi ?

Merci de votre aide précieuse,

Camille

Sub Save_PDF_bureau()
    Dim xx As String
    Dim chemin As String
    Dim NomFichier As String

    chemin = "C:\Users\" & Environ("username") & "\Desktop"
    NomFichier = "test.pdf"

    '
    ' Tester l'éxistence du fichier
    xx = Dir(chemin & "\" & NomFichier)
    If xx <> "" Then
        '
        ' Si le fichier existe, demander à l'utilisateur s'il faut l'écraser
        If MsgBox("le fichier" & NomFichier & " existe déjà dans " & chemin & " Faut-il l'écraser ? ", vbYesNo + vbQuestion, "Création d'un fichier PDF - Document existant") = vbYes Then
            ' si l'utilisateur a répondu oui : Suppression du fichier existant
           Kill chemin & "\" & NomFichier
        Else
            ' Sinon sortir sans enregistrer le fichier
           Exit Sub
        End If
    End If
        ' Enrgistrement du fichier
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=chemin & "\" & NomFichier, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=True
End Sub

Bonjour,

J'utilise le code ci-dessous pour enregistrer mon tableau Excel en CSV. J'aimerais qu'il me propose une boite de dialogue pour inscrire le nom du fichier à enregistrer. Avec ce code, le fichier s'appelle toujours "Classeur10"

Quelqu'un aurait-il une solution ?

Sub Save1()

    ActiveWorkbook.SaveAs Filename:= _
        "C:\Classeur10.csv", FileFormat:= _
        xlCSV, CreateBackup:=True, local:=True

End Sub

Merci d'avance.

Bonjour, j'ai un fichier dans lequel se trouve une macro qui simplement enregistre en PDF. Jusque là rien de compliquer mais le soucis c'est qu'il n'enregistre pas le fichier créé dans le dossier "source" d'où on ouvre le fichier xls mais dans le dossier Document. J'ai pensé qu'avec un sélectionneur de dossier avant la macro d'enregistrement ça ira mais non il continue à m'enregistrer ça dans Document.

J'avoue que je sèche un peu sur la source du problème... .

Macro:

Spoiler

Sub PDF()

Dim fd As Office.FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

fd.Title = "Sélectionnez un dossier..."

If fd.Show() Then

MsgBox "Vous avez sélectionné le dossier : " _

& vbCrLf & fd.SelectedItems(1), vbInformation

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Check " & [I8].Value & " du " & Day(Now) & "-" & Month(Now) & "-" & Year(Now)

End If

Set fd = Nothing

End Sub

D'avance merci.

Bonjour

je reviens vers vous aujourd’hui car je ne sais pas comment m'y prendre et si c'est possible!

Je souhaiterais effectuer un publipostage vers Word de données contenues dans mon fichier excel, en cliquant sur un bouton me imprimer

que le dernier enregistrement. le code pour le moment me imprime tous les enregistrements; voici le code:

Private Sub CommandButton5_Click()

'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"

Dim docWord As Word.Document

Dim appWord As Word.Application

Dim NomBase As String

NomBase = "\\192.168.0.107\Google Drive\partage\POINTAGESVS\Nouveau dossier (2)\SIDALI.xlsm"

Application.ScreenUpdating = False

Set appWord = New Word.Application

appWord.Visible = True

'Ouverture du document principal Word

Set docWord = appWord.Documents.Open("\\192.168.0.107\Google Drive\partage\POINTAGESVS\Nouveau dossier (2)\contrat.docx")

'fonctionnalité de publipostage pour le document spécifié

With docWord.MailMerge

'Ouvre la base de données

.OpenDataSource Name:=NomBase, _

Connection:="Driver={Microsoft Excel Driver (*.xlsm)};" & _

"DBQ=" & NomBase & "; ReadOnly=True;", _

SQLStatement:="SELECT * FROM [contrat$]"

'Spécifie la fusion vers l'imprimante

.Destination = wdSendToPrinter

.suppressBlankLines = True

'Prend en compte l'ensemble des enregistrements

With DataSource

.ActiveRecord = i - 1

End With

'Exécute l'opération de publipostage

.Execute Pause:=False

End With

Application.ScreenUpdating = True

'Fermeture du document Word

docWord.Close False

appWord.Quit

End Sub

Merci par avance de votre aide

Bonjour à tous,

je souhaite exécuter une macro au moment où l'on enregistre un classeur.

Je suis aller dans VBA, sous ThisWorbook, puis j'ai sélectionné Worbook à gauche et BeforSave à droite.

Là, j'ai mis mon code :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Sub enregitrement()
    With ThisWorkbook
        .Save
    End With

    Application.Workbooks(1).SaveAs _
"http://monsitesharepoint/doc/test.xlsm"

   MsgBox "L'enregistrement a été correctement."
End Sub

A chaque fois, j'ai des erreurs et excel plante...

Je fais quoi de faux ? (je suis débutant en VBA...)

Bonjour à tous,

J'ai des rapports qui via un code VBA s'enregistrent automatiquement dans un répertoire avec des noms définis en se basant sur un fichier de structure "Template". La macro fonctionne parfaitement, mais elle affiche l'erreur suivante pour certains rapports "Erreur 1004 - Document non enregistré", ce qui m'oblige de tout fermer et de la relancer pour qu'elle continue à générer les rapports.

Je souhaite trouver une solution pour que la macro puisse générer l'ensemble des rapports sans interruption, merci d'avance pour votre aide!!!

Ligne concernée par l'erreur:

   ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlExcel12, CreateBackup:=False

Le code de la fonction:

Private Function updateRapport(paire As String, code_region As String, code_classement As Integer, repertoirejour As String, Fichierformesource As String, TypeRapport As String, ShowPDF As Boolean)

    Dim wb_target As Workbook
    Dim fichier As String
    Dim DEPOT As String

    DEPOT = sources.Cells(5, 2).Value

    Windows(ThisWorkbook.Name).Activate
    Sheets("Modop").Select

    ' on ouvre le fichier de structure (source) qui sert de base à tous les fichiers de region
    ' on copie les informations nécessaires

    'wb_target.Activate

    'date du jour dans le premier onglet
    Sheets("Accueil").Select
    Range("G5:H5").Value = Now()

    'changement du titre/nom de la région
    Sheets("Rapport opérationnel").Select
    Range("G1:L2").Select
    ActiveCell.FormulaR1C1 = paire

    'enregistrement A MODIFIER
    'Application.Calculation = xlAutomatic
   'supprimer les lignes datant d'aujourd'hui

    Application.Calculate
   'nettoyage de l'onglet C_REAL
    Sheets("Calculs").Select
    If Sheets("Calculs").Range("N2").Value <> "KO" Then
       Sheets("C_REAL").Select
        Range("A1:BD1").Offset(Sheets("Calculs").Range("N2").Value - 1, 0).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp

    End If
    'nettoyage de l'onglet C_VV
     If Sheets("Calculs").Range("O2").Value <> "KO" Then
       Sheets("C_VV").Select

        Range("A1:AC1").Offset(Sheets("Calculs").Range("O2").Value - 1, 0).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp

    End If

    ActiveWorkbook.RefreshAll
    Application.Calculate

    Sheets("Calculs").Visible = False
    Sheets("Rapport opérationnel").Select
    Range("A1").Select
    'ActiveWorkbook.Save

    'enregistrement du fichier .xlsb avec la date
    fichier = repertoirejour & "\" & "Données - " & paire & " - " & Format(Date, "yyyy-mm-dd") & ".xlsb"

    ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlExcel12, CreateBackup:=False

    Sheets("Rapport opérationnel").Select
    'enregistrement en pdf avec date
    If paire = "Données XX_XX_XX_XX_XX" Then

        fichier = repertoirejour & "\" & "Données - " & "XX_XX_XX_XX" & " - " & Format(Date, "yyyy-mm-dd") & ".pdf"

    ElseIf paire = "Données XX_XX_XX_XX" Then

        fichier = repertoirejour & "\" & "Données - " & "XX_XX_XX" & " - " & Format(Date, "yyyy-mm-dd") & ".pdf"

    Else
        fichier = repertoirejour & "\" & "Données - " & paire & " - " & Format(Date, "yyyy-mm-dd") & ".pdf"
    End If
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=ShowPDF
    'enregistrement en pdf dans repertoire partagé avec strat A MODIFIER

    'fermeture du fichire Excel
    ActiveWorkbook.Close False

End Function

Bonjour à tous

J'ai assemblé ce code en plusieurs étapes.

Le code est dans Thisworkbook

En premier sauvegarde classique , Un bouton -> Msgbox Yes Non enregistrement Correct.

J'ai voulu mettre en plus la date heure et nom du fichier .

c'est là que ça ce complique , il ne fait que la première partie .

Ma question est Pourquoi

Sub Fermeture_Cliquer()

Dim Path As String, valeur As String

Path = ActiveWorkbook.Path & "C:\Users\dany\Desktop\RESERV NACELLE\Resevation Nacelle" 'Zone Stockage

valeur = "Reserva " & Format(Date, "dd-mmmm-yyyy") & "_" & Format(Time, "hh-mm") & ".xls" ' Nom Date Heure Format de fichier

Reponse = MsgBox("Voulez-vous enregistrer les modifications ?", vbYesNo, "Demande de confirmation")

ThisWorkbook.Save

Application.Quit

End Sub

Merci de votre aide

LedZep

Bonjour

J'essaie d automatiser l'enregistrement d un fichier par VBA mais mon code bloque sur la method "SaveAs"... des idees pour resoudre mon probleme?

Sub enregistrer_as()

Dim Name As String
Dim main As Worksheet

Set main = ActiveWorkbook.Sheets("Main")

Name = "Quotes at " & main.Range("AB1")

ActiveWorkbook.SaveAs Filename:="S:\Desk_Credit\Primaire\TCA" & Name

End Sub

merci d avance

Bonjour le forum, petite question;

J'ai ce code qui me permets, sur un bouton, de sauvegarder la feuille actuelle dans un dossier precis avec le nom "Fiche_Mouvement_" & Range("H5") & extension.

A aujourd'hui, j'aimerai enregistrer tout le classeur et non la feuille active et je bloque, pouvez vous m'aide rsvp, merci :

Else
    Dim extension As String
    Dim chemin As String, nomfichier As String
    Dim style As Integer
    Application.ScreenUpdating = False
    ThisWorkbook.ActiveSheet.Copy
    extension = ".xlsx"
    chemin = "c:\DATAS\fiches_de_mouvements\"
    nomfichier = ActiveSheet.Range("A1") & "Fiche_Mouvement_" & Range("H5") & extension
    With ActiveWorkbook
        .SaveAs Filename:=chemin & nomfichier
        .Close
    End With
     End If
    End Sub

Bonsoir,

Je voudrais que lorsqu'on clique sur mon bouton "btnAjouter" (qui permet d'ajouter un client à ma bdd), il affiche le msg d'erreur si tout n'est pas complet mais qu'il ne me rempli pas un nouvel enregistrement dans ma bdd sans avoir toutes les informations.

'Procédure permettant d'ajouter un nouveau client dans la base de données
Private Sub btnAjouter_Click()
    'On teste la saisie des champs dans le formulaire
    If Len(Me.txtNom) = 0 Then
        lblMessage = "Veuillez saisir le nom du client"
        'MsgBox "Veuillez saisir le nom du client"
        Me.txtNom.SetFocus
    ElseIf Len(Me.txtPrenom) = 0 Then
        lblMessage = "Veuillez saisir le prénom du client"
        Me.txtPrenom.SetFocus
    ElseIf Len(Me.txtDateNaissance) = 0 Then
        lblMessage = "Veuillez saisir la date de naissance du client"
        Me.txtDateNaissance.SetFocus
    ElseIf Len(Me.cboProfession) = 0 Then
        lblMessage = "Veuillez sélectionner la profession du client"
        Me.cboProfession.SetFocus
    ElseIf Len(Me.cboPaiement) = 0 Then
        lblMessage = "Veuillez sélectionner la fréquence de paiement"
        Me.cboPaiement.SetFocus
    ElseIf Len(Me.txtNbPersonne) = 0 Then
        lblMessage = "Veuillez saisir le nombre de personne à assurer auprès du client"
        Me.txtNbPersonne.SetFocus
    ElseIf (Me.OptnAcciCorpNon) = False And (Me.OptnAcciCorpOui) = False Then
        lblMessage = "Veuillez choisir si le client prend une assurance d'accidents corporels du client"
        Me.txtPrenom.SetFocus
    Else
        lblMessage = ""
    End If

    Sheets("Clients").Activate
    Range("A1").Select
    Selection.End(xlDown).Select 'On se positionne sur la dernière ligne non vide
    Selection.Offset(1, 1).Select 'On se décale d'une ligne vers le bas
    ActiveCell = txtNom.Value
    ActiveCell.Offset(0, 1).Value = txtPrenom
    ActiveCell.Offset(0, 2).Value = txtDateNaissance
    ActiveCell.Offset(0, 3).Value = cboProfession
    ActiveCell.Offset(0, 4).Value = cboAssuranceHospi
    If (Me.OptnAcciCorpOui) = True Then
        ActiveCell.Offset(0, 5).Value = "Oui"
    Else
        ActiveCell.Offset(0, 5).Value = "Non"
    End If
    ActiveCell.Offset(0, 6).Value = txtCapitaux
    ActiveCell.Offset(0, 7).Value = txtNbPersonne

   With ActiveSheet.ListObjects(1)
        'si dernière ligne du tableau non vide, ajout d'une ligne
        If .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) <> Empty Then .ListRows.Add
        'incrémentation automatique du numéro de client
        .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = Application.Max(.ListColumns("Num Client").DataBodyRange) + 1
    End With

End Sub

Bonjour à tous,

Alors tout d'abord, je préviens que je débute sur VBA, et que ma question est peut être très simple à résoudre!

Mon souci est le suivant : j'ai des rapports à rendre, des graphes pour être précis, que je désire faire en forme de macro pour qu'ils s'enregistrent directement vers le chemin de destination que je souhaite. J'ai donc enregistré la macro et peaufiner pour avoir ce que je désire exactement :

While Compteur <= Sheets.Count
    Sheets(Compteur).Activate
     Dim DateAujd As String
    DateAujd = Date
    Dim Test As String
    Test = DateAujd & "\" & ActiveSheet.Name
    Range("Z7000").Value = Test

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        "C:\reporting\2018\CA sites - détails famille\" & "\" & Test, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True

   Compteur = Compteur + 1
    Wend

L'idée est donc d'avoir une destination qui prend en compte la date quand je l'effectue et enfin le nom du fichier (de la feuille). Style C:\reporting\2018\CA sites - détails famille \11-04-18\NomDeLaFeuille.

Le code de destination, c'est le programme qui me l'a fait quand j'ai enregistré la macro, et qui fonctionne très bien si avec ce code "C:\reporting\2018\04-2018\CA sites - détails famille\" & ActiveSheet.Name.

Mais à nouveau, je ne veux PAS écrire moi même la date, par fainéantise . Après plusieurs test (pour ça que je joue avec date, test, etc...), je me suis rendu compte que le problème qui se pose vient du rajout de "\" (j'avais d'ailleurs essayé un FileName du style C:\reporting\2018\CA sites - détails famille\" & Date & "\" & ActiveSheet.Name, sans succès) que ce soit directement dans le FileName, ou via le Dim Test. D'où le fait que je pense qu'il y a un souci de format. Pourriez vous m'indiquer une solution à ce petit problème? Je vous en serai éternellement reconnaissant!

Autre question, rien à voir avec le problème précédent; est-il possible de, imaginons que j'ai 20 feuilles qui sortent en pdf, de faire des combinaisons de 2 feuilles sur un seul pdf? (Au lieu d'avoir 20 PDF pour mes 20 rapports, je veux 10 pdf avec 2 rapports dessus, le 1-2, 3-4... 19-20 ensemble). Tout çà à nouveau concerne l'enregistrement.

Désolé pour le pavé, j'essai d'être le plus précis possible

Merci d'avance!

Bonjour, je vous explique rapidement ma situation.

Je souhaiterai mettre en place un bouton d'enregistrement dans un fichier que je ne peux partager malheureusement (confidentiel)

Pour cela j'ai rédigé cette macro, évidament n'étant pas un expert en VBA elle ne marche pas .

Sub Macro13()

Dim Nom As String

Nom = Worksheets("Dispensettes").Range("K2") -> défintion du nom

ActiveWorkbook.SaveAs Filename:="[I20]", FileFormat:=xlNormal -> Fichier d'enregistrement varie selon la valeur de I20

End Sub

Je vous remercie de l'aide que vous pourrez m'apporter

Jonathan

Bonjour,

j'ai un fichier avec un code vba qui fonctionne trés bien pour enregistrement auto, voici le code:

Sub EnregistrerSous()

Dim Chemin As String, Mois As String, Année As String, Fichier As String

If Not ActiveSheet.Name = "CR Facture" Then Exit Sub

Mois = Replace(Replace(Replace(Format(Range("C24").Value, "mmmm"), "é", "e"), "è", "e"), "û", "u")

Année = Year(Range("C24").Value)

'chemin

Chemin = "C:\Users\christophe\Google Drive\promedep drive\Nouvelle gestion\feuille d'inter avant 01042015\Facture "

Chemin = Chemin & Mois & " " & Année & "\Fac " & Mois & " " & Année & "\"

'fichier

Fichier = ActiveWorkbook.Name

Fichier = Range("B24").Value & "_" & Fichier

ActiveWorkbook.SaveAs Filename:=Chemin & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

J'ai donner ce fichier a un amis pour utilisation et j'ai voulu lui adapter l'enregistrement et j'ai donc changé juste le chemin d'accès mais cela ne fonctionne pas.... et voici ce que cela donne:

Sub EnregistrerSous()

Dim Chemin As String, Mois As String, Année As String, Fichier As String

If Not ActiveSheet.Name = "CR Facture" Then Exit Sub

Mois = Replace(Replace(Replace(Format(Range("C24").Value, "mmmm"), "é", "e"), "è", "e"), "û", "u")

Année = Year(Range("C24").Value)

'chemin

Chemin = "C:\Users\CHRISTOPHE\Desktop\seb "

Chemin = Chemin & Mois & " " & Année & "\Fac " & Mois & " " & Année & "\"

'fichier

Fichier = ActiveWorkbook.Name

Fichier = Range("B24").Value & "_" & Fichier

ActiveWorkbook.SaveAs Filename:=Chemin & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

pour info: pour l'instant tout est encore en test sur mon pc, je changerai le début du chemin une fois sur son pc.

Quelqu'un a t'il la solution?

Merci d'avance pour votre aide

Bonjour

je réalise un publipostage WORD à partir d’excel .

Je rencontre 2 problèmes.

1.Lorsque le publipostage est effectué , à la fermeture de word , ce message s’affiche

Comment éviter ce message ?

2.le fichier pdf doit être enregistré sous le nom d'un champ publiposté c'est-à-dire qu’il doit reprendre la concaténation des cellules B2,E2,F2 ,H2 de la feuil 1.

Comment faire ?

Merci de toute aide

Sub test()
'Enregistre le fichier au format.pdf
  'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String

    NomBase = "C:\test\Classeur1.xlsm"
      Application.ScreenUpdating = False
      Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open("C:\test \Publipostage.docx")
       'fonctionnalité de publipostage pour le document spécifié
    With docWord.MailMerge
    'Ouvre la base de données
        .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xlsx)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
      'Exécute l'opération de publipostage
      .Execute Pause:=False
    End With
    ' Sauvegarde du document publiposté
    With appWord.ActiveDocument
    .ExportAsFixedFormat OutputFileName:="C:\test\fiche.pdf", ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False
     End With
    Application.ScreenUpdating = True
       'Fermeture du document Word
       docWord.Close False
        appWord.Quit
      End Sub

oups , j'ai omis de dire le message affiché .

"Voulez vous enregistrer les modifications apportés à lettres 1 ?"

Bonjour à la communauté,

Je sollicite une nouvelle fois les personnes du forum pour simplifier mon code VBA que j'ai créé uniquement avec l'enregistreur. Problème, il fait bugger les (vieux) PC sous Windows sous lesquels le fichier est utilisé (personnellement il fonctionne plutôt rapidement, je travail sur Mac plutôt récent).

Une âme charitable, s'il vous plait, pour m'aider à la simplification de mon enregistrement de commande VBA? Ce code prend les données qui me sont utiles dans les 2 premières feuilles (extraction de données via un site internet) et les ajoutes sur une troisième feuille : "Result". Cette dernière représente la base de mon traitement de données pour la suite de mon fichier.. Bref, voici mon code actuel:

Sub ClicOne()

'

' ClicOne Macro

Sheets("Extract payment").Select

Columns("D:D").Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("C:C").Select

Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

:=Array(Array(1, 1), Array(2, 1))

Columns("C:C").Select

Selection.Copy

Sheets("Result").Select

Columns("B:B").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("D:D").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("C:C").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("F:F").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("D:D").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("J:J").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("G:G").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("L:L").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("H:H").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("P:P").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("I:I").Select

ActiveSheet.Paste

Range("E1").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "Owner name"

Range("E2").Select

ActiveCell.FormulaR1C1 = _

"=IF(ISNA(INDEX('Extract account'!C[20],MATCH(Result!RC[-1],'Extract account'!C[-3],0))),"""",(INDEX('Extract account'!C[20],MATCH(Result!RC[-1],'Extract account'!C[-3],0))))"

Range("D2").Select

Selection.Copy

Range("E2").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("E2:E9"), Type:=xlFillDefault

Range("E2:E9").Select

Selection.AutoFill Destination:=Range("E2:E7042"), Type:=xlFillDefault

Range("E2:E7042").Select

Range("F1").Select

ActiveCell.FormulaR1C1 = "Account status"

Range("F2").Select

ActiveCell.FormulaR1C1 = _

"=IF(ISNA(INDEX('Extract account'!C[3],MATCH(Result!RC[-2],'Extract account'!C[-4],0))),"""",(INDEX('Extract account'!C[3],MATCH(Result!RC[-2],'Extract account'!C[-4],0))))"

Range("E2").Select

Selection.Copy

Range("F2").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("F2:F7006"), Type:=xlFillDefault

Range("F2:F7006").Select

Range("J1").Select

ActiveCell.FormulaR1C1 = "Costumer Region"

Range("H1").Select

Selection.Copy

Range("J1").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Range("J2").Select

ActiveCell.FormulaR1C1 = _

"=IF(ISNA(INDEX('Extract account'!C[22],MATCH(Result!RC[-6],'Extract account'!C[-8],0))),"""",(INDEX('Extract account'!C[22],MATCH(Result!RC[-6],'Extract account'!C[-8],0))))"

Range("J2").Select

Selection.AutoFill Destination:=Range("J2:J3"), Type:=xlFillDefault

Range("J2:J3").Select

Range("I2").Select

Selection.Copy

Range("J2").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("J2:J7022"), Type:=xlFillDefault

Range("J2:J7022").Select

Columns("B:J").Select

Range("J1").Activate

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.MergeCells = False

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.ShrinkToFit = False

.MergeCells = False

End With

Selection.ColumnWidth = 18.33

Range("C1:J1").Select

Range("J1").Activate

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Range("A11").Select

End Sub

Vous pouvez voir que c'est long et que ça doit bien faire mouliner les PC..

Je rajouterai que ce code est la première partie d'un outil que je souhaite développer avec plusieurs autres macro pour lesquels j'ai déjà sollicité les membres de la communauté ici. Du coup, ce premier code plutôt "pompeux" et peu rapide, ralenti vraiment l'outil.

Le fichier est également en pièce jointe.

Merci à tous pour l'aide sur ce site et merci d'avance aux personnes qui s'arrêterons pour m'aider!

Bonne journée à tous.

14test-forum.xlsm (408.32 Ko)

Recherches récentes

verouillefiltre tcdliste deroulantelisterecherche repertoire entierrecherche dossiercouleurinterdire acces feuilles classeuruboundpartager classeur macro vbacherche textedimgestion immobilisationssource tcdsuivi immobilisationscreer superieur organigrammerecherche comboboxouvrir doc word via vbaremplir signet word via vbacompiler tableaux