IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Futur Membre du Club
    Femme Profil pro
    Assistant aux utilisateurs
    Inscrit en
    mars 2021
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 41
    Localisation : France, Calvados (Basse Normandie)

    Informations professionnelles :
    Activité : Assistant aux utilisateurs
    Secteur : Distribution

    Informations forums :
    Inscription : mars 2021
    Messages : 15
    Points : 9
    Points
    9
    Par défaut Ouvrir une boite de dialogue pour sélectionner un fichier dans mon code
    Bonjour tout le monde,

    J'ai un code VBA où je veux s'il ne trouve pas le fichier word concerné dans le chemin indiqué qu'il m'ouvre une boîte de dialogue pour pour pouvoir le sélectionner. Je veux savoir si c'est possible d'avoir un code qui prend en considération le nouveau chemin pour les utilisations ultérieurs pour que je ne sois pas obligé de l'indiquer dans mon code VBA. Merci infiniment.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Sub publipost()
     
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
     
    Set wdApp = New Word.Application
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Open("C:\Users\PC\Desktop\ACCESS\SUBROGATION\test\lettre.docx")
     
    With wdDoc.MailMerge
        .OpenDataSource Name:="C:\Users\PC\Desktop\ACCESS\SUBROGATION\test\SUBROGATION 2021 Finale - Copie.accdb", SQLStatement:="SELECT * FROM [RPUBLI]"
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        .Execute
    End With
     
    wdDoc.Close False
    Set wdDoc = Nothing
    wdApp.Quit
    Set wdApp = Nothing
     
    End Sub

  2. #2
    Membre émérite Avatar de Zekraoui_Jakani
    Homme Profil pro
    Inscrit en
    novembre 2013
    Messages
    1 506
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations forums :
    Inscription : novembre 2013
    Messages : 1 506
    Points : 2 313
    Points
    2 313
    Par défaut
    Vous pouvez tester ce code (après adaptation de votre répertoire):
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    Sub OuvrirDocWord()
     
        Dim Chemin, CheminAlternatif As String
        Chemin = "C:\Users\PC\Desktop\ACCESS\SUBROGATION\test\lettre.docx"
        CheminAlternatif = "C:\Users\PC\Desktop\ACCESS\SUBROGATION\"    'A modifier à souhait *************
     
        'Vérifier l'information du répertoire indiqué
        If IsNull(Chemin) Or Chemin = "" Then
            MsgBox "Veuillez vérfier l'existence du répertoire : " & vbCrLf & _
                    "'" & Chemin & "'", vbInformation, "Répertoire Inconnu"
            Exit Sub
        Else
            'Vérifier l'existencce du document indiqué
            If Dir(Chemin) = "" Then
                MsgBox "Le Document spécifié n'existe pas sous le répertoire indiqué !" & vbCrLf & _
                        "Veuillez choisir le bon dossier manuellement !", _
                       vbExclamation, "Document Inexistant"
                'Choix manuel du fichier voulu
                RepertoireAlternatif CheminAlternatif
            Else
                OuvrirDocument (Chemin)
            End If
        End If
    End Sub
     
    Function RepertoireAlternatif(ByVal myPath As String) As Boolean
    ' nécessite la référence "Microsoft Office 16.0 Object Library" ou +haut.
     
        Dim fDialog As Object
        Dim varFile As Variant
        Dim SelectedFile As String
        Dim myMsg As String
     
        SelectedFile = ""
        Set fDialog = Application.FileDialog(1)
     
        With fDialog
           .AllowMultiSelect = False
           .InitialFileName = myPath
           .Title = "Veuillez choisir le fichier à ouvrir"
           .filters.Clear
           .filters.Add "All Files", "*.Doc*"
     
            If .Show = True Then
                For Each varFile In .SelectedItems
                    SelectedFile = varFile
                    RepertoireAlternatif = True
                Next
            Else
               MsgBox "Vous n'avez choisi aucun fichier.", vbOKOnly, "Choix du fichier à traiter"
               RepertoireAlternatif = False
            End If
        End With
     
        If RepertoireAlternatif = True Then OuvrirDocument SelectedFile
    End Function
     
    Sub OuvrirDocument(strDocName As String)
        Dim objApp As Object
     
        'Ouvrir le document sélectionné
     
        Set objApp = CreateObject("Word.Application")
        objApp.Visible = True
        objApp.Documents.Open strDocName
        MsgBox "Le document est ouvert !", vbOKOnly, "Document Ouvert"
     
    End Sub

  3. #3
    Futur Membre du Club
    Femme Profil pro
    Assistant aux utilisateurs
    Inscrit en
    mars 2021
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 41
    Localisation : France, Calvados (Basse Normandie)

    Informations professionnelles :
    Activité : Assistant aux utilisateurs
    Secteur : Distribution

    Informations forums :
    Inscription : mars 2021
    Messages : 15
    Points : 9
    Points
    9
    Par défaut
    Merci Zekraoui_Jakani pour ta réponse. J'ai une petite demande si ça t'embête pas, comme je suis encore novice est ce que tu peux intégrer le code que tu as proposé dans le mien comme ça je n'aurai qu'à modifier le chemin.
    J'ai essayé seul mais je n'arrive pas. Merci infiniment.

  4. #4
    Membre émérite Avatar de Zekraoui_Jakani
    Homme Profil pro
    Inscrit en
    novembre 2013
    Messages
    1 506
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations forums :
    Inscription : novembre 2013
    Messages : 1 506
    Points : 2 313
    Points
    2 313
    Par défaut
    Je n'ai pas pu tester la partie 'publipostage' car je n'ai pas accès à la source !!
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    Sub OuvrirDocWord()
     
        Dim Chemin, CheminAlternatif As String
        Chemin = "C:\Users\PC\Desktop\ACCESS\SUBROGATION\test\lettre.docx"
        CheminAlternatif = "C:\Users\PC\Desktop\ACCESS\SUBROGATION\"    'A modifier à souhait *************
     
        'Vérifier l'information du répertoire indiqué
        If IsNull(Chemin) Or Chemin = "" Then
            MsgBox "Veuillez vérfier l'existence du répertoire : " & vbCrLf & _
                    "'" & Chemin & "'", vbInformation, "Répertoire Inconnu"
            Exit Sub
        Else
            'Vérifier l'existencce du document indiqué
            If Dir(Chemin) = "" Then
                MsgBox "Le Document spécifié n'existe pas sous le répertoire indiqué !" & vbCrLf & _
                        "Veuillez choisir le bon dossier manuellement !", _
                       vbExclamation, "Document Inexistant"
                'Choix manuel du fichier voulu
                RepertoireAlternatif CheminAlternatif
            Else
                OuvrirDocument (Chemin)
            End If
        End If
    End Sub
     
    Function RepertoireAlternatif(ByVal myPath As String) As Boolean
    ' nécessite la référence "Microsoft Office 16.0 Object Library" ou +haut.
     
        Dim fDialog As Object
        Dim varFile As Variant
        Dim SelectedFile As String
        Dim myMsg As String
     
        SelectedFile = ""
        Set fDialog = Application.FileDialog(1)
     
        With fDialog
           .AllowMultiSelect = False
           .InitialFileName = myPath
           .Title = "Veuillez choisir le fichier à ouvrir"
           .filters.Clear
           .filters.Add "All Files", "*.Doc*"
     
            If .Show = True Then
                For Each varFile In .SelectedItems
                    SelectedFile = varFile
                    RepertoireAlternatif = True
                Next
            Else
               MsgBox "Vous n'avez choisi aucun fichier.", vbOKOnly, "Choix du fichier à traiter"
               RepertoireAlternatif = False
            End If
        End With
     
        If RepertoireAlternatif = True Then OuvrirDocument SelectedFile
    End Function
     
    Sub OuvrirDocument(strDocName As String)
        Dim objApp As Object
        Dim wdDoc As Object
        Dim myMsg As String
     
        'Ouvrir le document sélectionné
        Set objApp = CreateObject("Word.Application")
        Set wdDoc = objApp.Documents.Open(strDocName)
        objApp.Visible = True
    '    objApp.Documents.Open strDocName
        myMsg = "Le document '" & strDocName & "' est ouvert !" & vbCrLf & vbCrLf
        myMsg = myMsg & "Le publipostage est prêt à êre lancé !"
        MsgBox myMsg, vbOKOnly, "Document Ouvert"
     
        'Lancer le publipostage
        With wdDoc.MailMerge
            .OpenDataSource name:="C:\Users\PC\Desktop\ACCESS\SUBROGATION\test\SUBROGATION 2021 Finale - Copie.accdb", _
                SQLStatement:="SELECT * FROM [RPUBLI]"
            .Destination = wdSendToPrinter
            .SuppressBlankLines = True
            .Execute
        End With
     
        wdDoc.Close False: Set wdDoc = Nothing
        objApp.Quit: Set objApp = Nothing
     
    End Sub

  5. #5
    Futur Membre du Club
    Femme Profil pro
    Assistant aux utilisateurs
    Inscrit en
    mars 2021
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 41
    Localisation : France, Calvados (Basse Normandie)

    Informations professionnelles :
    Activité : Assistant aux utilisateurs
    Secteur : Distribution

    Informations forums :
    Inscription : mars 2021
    Messages : 15
    Points : 9
    Points
    9
    Par défaut
    Merci infiniment pour votre effort Zekraoui_Jakani, le code marche très bien.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [PR-2013] Ouvrir une boite de dialogue pour récupérer un nom de fichier
    Par Jmichelc- dans le forum Project
    Réponses: 3
    Dernier message: 08/12/2017, 10h54
  2. [PR-2013] Ouvrir une boite de dialogue pour récupérer un nom de fichier
    Par Jmichelc- dans le forum VBA Project
    Réponses: 0
    Dernier message: 08/12/2017, 10h54
  3. Réponses: 3
    Dernier message: 19/02/2009, 16h26
  4. [A-03]Ouvrir une boite de dialogue pour selectionner un fichier
    Par Milyshyn76 dans le forum VBA Access
    Réponses: 3
    Dernier message: 16/10/2008, 14h26
  5. [Débutant] Ouvrir une boite de dialogue pour enregistrer un fichier
    Par pompier21 dans le forum Interfaces Graphiques
    Réponses: 2
    Dernier message: 09/10/2008, 10h09

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo