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

IHM Discussion :

Envoi d'un Etat par mail au format pdf en vba


Sujet :

IHM

  1. #1
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut Envoi d'un Etat par mail au format pdf en vba
    Bonjour,

    J'ai créé un code qui envoie un état par mail au format SNP et j'aimerais l'envoyer au format PDF.

    Voici une explication de la partie du code utilisée dans l'envoi du mail :

    On prend les adresses mail de diverses entreprises dans une table tbl_Maisons puis on envoie un état etEmail à chacune de ces entreprises.

    Voici le code :


    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
     Private Sub buEnvoiMail2_Click()
     
    On Error Resume Next
     
    'Déclaration dea variables
    Dim db As DAO.Database, qry As QueryDef
    Dim rs As DAO.Recordset
    Dim req As DAO.Recordset
    Dim mail, erreur As String
    Dim Entreprise As String
     
     
     
    Set db = CurrentDb
    'contrôle si la requête ReqEmail existe si non on la créé
    Set qry = db.QueryDefs("ReqEmail")
    If Err.Number <> 0 Then
    Set qry = db.CreateQueryDef("ReqEmail")
    Err.Clear
    End If
     
    'Selection des nom et adresses email des entreprises
    Set rs = CurrentDb.OpenRecordset("SELECT [tbl_Maisons].Entreprise, [tbl_Maisons].[email] FROM [tbl_Maisons];")
     
    'Boucle qui passe en revue toutes les entreprises
    While Not rs.EOF
    'Création de la requête avec les variables de l'entreprise en cours...
    qry.SQL = "PARAMETERS semaine Value;" & _
    " SELECT Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine,[tbl_Maisons].N° AS Code," & _
    " [tbl_Maisons].Entreprise, Last(Regie_base2.Branche) AS DernierDeBranche, Last([tbl_Maisons].Nom) AS Reference, Last([tbl_Maisons].Rue) AS DernierDeRue," & _
    " Last([tbl_Maisons].Npa) AS DernierDeNpa, Last([tbl_Maisons].Ville) AS DernierDeVille, Last([tbl_Maisons].Fax) AS DernierDeFax, Last(Regie_base2.Qualite) AS DernierDeQualite, " & _
    " Last(Regie_horaire.Matricule) AS DernierDeMatricule, Last(Regie_base2.Nom) AS DernierDeNom, Last(Regie_base2.Prenom) AS DernierDePrenom, Last(Regie_base2.Centre_cout) AS DernierDeCentre_cout," & _
    " Last([Rqt_base_Analyse croisée].[Total de Heures]) AS [DernierDeTotal de Heures], Last(Regie_base2.Tarif) AS DernierDeTarif, Last(([Total de Heures]*[Tarif])) AS Montant, [Rqt_base_Analyse croisée].lun," & _
    " [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
    " FROM ([Rqt_base_Analyse croisée] LEFT JOIN Regie_horaire ON [Rqt_base_Analyse croisée].Matricule = Regie_horaire.Matricule) LEFT JOIN (Regie_base2 LEFT JOIN [tbl_Maisons] ON Regie_base2.Code = [tbl_Maisons].N°)" & _
    " ON [Rqt_base_Analyse croisée].Matricule = Regie_base2.Matricule" & _
    " WHERE [tbl_Maisons].Entreprise = " & Chr(34) & rs("Entreprise") & Chr(34) & _
    " GROUP BY Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine, [tbl_Maisons].N°, [tbl_Maisons].Entreprise, [Rqt_base_Analyse croisée].lun, [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
    " HAVING (((Regie_base2.Societe) = 'cimo') And (([Rqt_base_Analyse croisée].semaine) = [semaine]))" & _
    " ORDER BY [tbl_Maisons].Entreprise DESC;"
     
    'La variable entreprise prend le nom de l'entreprise en cours
    Entreprise = rs("Entreprise")
     
    'La variable mail prend l'email de l'entreprise en cours
    mail = rs("EMail")
     
    'test pour savoir s'il existe une adresse email
    If (mail <> "") Then
    'envoi de l'état en format snp à l'adresse email correspondant
    DoCmd.SendObject acReport, "etEmail", acFormatSNP, mail, , , , Chr(10) & Chr(10) & "Si vous n'arrivez pas à ouvrir le document, vous pouvez télécharger le programme a cette adresse :" & Chr(10) & "http://www.microsoft.com/... "
     
    'si l'entreprise n'a pas d'adresse email un message d'erreur s'affiche
    Else
    erreur = MsgBox("Il n'y a pas d'adresse email pour l'entreprise :" & Entreprise, vbOKOnly, "Email invalide")
    End If
     
    'En cas d'annulation de l'utilisateur on passe à l'entreprise suivante
    On Error Resume Next
     
    rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
    Set db = Nothing
     
    erreur:
    MsgBox "Le mail n'a pas été envoyé", , "Action annulée"
    Exit Sub
     
    End Sub

    Serait-il possible d'avoir une petite aide svp ?

    Merci

    Luis

  2. #2
    Membre éclairé
    Profil pro
    Inscrit en
    Décembre 2005
    Messages
    710
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2005
    Messages : 710
    Points : 847
    Points
    847
    Par défaut
    Salut,

    As tu regarder ici ?

    A+

  3. #3
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut
    Bonjour,

    Oui j'ai regardé et je n'ai pas réussi à faire fonctionner ce code, j'ai donc essayé de regarder ici

    Mais ça me met une erreur comme quoi j'aurai mis quelque chose après un End sub.

    Voici donc le code que j'ai maintenant :

    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
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    Option Compare Database
    Option Explicit
     
     
     
     
    Private Sub buEnvoiMail2_Click()
     
    On Error Resume Next
     
    'Déclaration dea variables et des fonctions
        Dim db As DAO.Database, qry As QueryDef
        Dim rs As DAO.Recordset
        Dim req As DAO.Recordset
        Dim mail, erreur As String
        Dim Entreprise As String
     
     
     
        Set db = CurrentDb
        'contrôle si la requête ReqEmail existe si non on la créé
        Set qry = db.QueryDefs("ReqEmail")
        If Err.Number <> 0 Then
            Set qry = db.CreateQueryDef("ReqEmail")
            Err.Clear
        End If
     
        'Selection des nom et adresses email des entreprises
        'J'ai créé une nouvelle table car la personne qui a créé la table d'orginine a mis des espaces dans le nom!!!!!!
        Set rs = CurrentDb.OpenRecordset("SELECT [tbl_Maisons].Entreprise, [tbl_Maisons].[EMail] FROM [tbl_Maisons];")
     
        'Boucle qui passe en revue toutes les entreprises
        While Not rs.EOF
        'Création de la requête avec les variables de l'entreprise en cours...
            qry.SQL = "PARAMETERS semaine Value;" & _
            " SELECT Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine,[tbl_Maisons].N° AS Code," & _
            " [tbl_Maisons].Entreprise, Last(Regie_base2.Branche) AS DernierDeBranche, Last([tbl_Maisons].Nom) AS Reference, Last([tbl_Maisons].Rue) AS DernierDeRue," & _
            " Last([tbl_Maisons].Npa) AS DernierDeNpa, Last([tbl_Maisons].Ville) AS DernierDeVille, Last([tbl_Maisons].Fax) AS DernierDeFax, Last(Regie_base2.Qualite) AS DernierDeQualite, " & _
            " Last(Regie_horaire.Matricule) AS DernierDeMatricule, Last(Regie_base2.Nom) AS DernierDeNom, Last(Regie_base2.Prenom) AS DernierDePrenom, Last(Regie_base2.Centre_cout) AS DernierDeCentre_cout," & _
            " Last([Rqt_base_Analyse croisée].[Total de Heures]) AS [DernierDeTotal de Heures], Last(Regie_base2.Tarif) AS DernierDeTarif, Last(([Total de Heures]*[Tarif])) AS Montant, [Rqt_base_Analyse croisée].lun," & _
            " [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " FROM ([Rqt_base_Analyse croisée] LEFT JOIN Regie_horaire ON [Rqt_base_Analyse croisée].Matricule = Regie_horaire.Matricule) LEFT JOIN (Regie_base2 LEFT JOIN [tbl_Maisons] ON Regie_base2.Code = [tbl_Maisons].N°)" & _
            " ON [Rqt_base_Analyse croisée].Matricule = Regie_base2.Matricule" & _
            " WHERE [tbl_Maisons].Entreprise = " & Chr(34) & rs("Entreprise") & Chr(34) & _
            " GROUP BY Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine, [tbl_Maisons].N°, [tbl_Maisons].Entreprise, [Rqt_base_Analyse croisée].lun, [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " HAVING (((Regie_base2.Societe) = 'cimo') And (([Rqt_base_Analyse croisée].semaine) = [semaine]))" & _
            " ORDER BY [tbl_Maisons].Entreprise DESC;"
     
            'La variable entreprise prend le nom de l'entreprise en cours
            Entreprise = rs("Entreprise")
     
            'La variable mail prend l'email de l'entreprise en cours
            mail = rs("EMail")
     
            'test pour savoir s'il existe une adresse email
            If (mail <> "") Then
            'envoi de l'état en format snp à l'adresse email correspondant
            DoCmd.SendObject acReport, "etEmail", acFormatSNP, mail, , , , Chr(10) & Chr(10) & "Si vous n'arrivez pas à ouvrir le document, vous pouvez télécharger le programme a cette adresse :" & Chr(10) & "http://www.microsoft.com/downloads/details.aspx?familyid=b73df33f-6d74-423d-8274-8b7e6313edfb&displaylang=fr "
     
            'si l'entreprise n'a pas d'adresse email un message d'erreur s'affiche
            Else
            erreur = MsgBox("Il n'y a pas d'adresse email pour l'entreprise :" & Entreprise, vbOKOnly, "Email invalide")
            End If
     
            'En cas d'annulation de l'utilisateur on passe à l'entreprise suivante
            On Error Resume Next
     
            rs.MoveNext
        Wend
    rs.Close
    Set rs = Nothing
    Set db = Nothing
     
    erreur:
    MsgBox "Le mail n'a pas été envoyé", , "Action annulée"
    Exit Sub
     
    End Sub
     
     
    Private Sub ImprimerPDF_Click()
     
        'Declaration des fonctions
        Private originalPrinter As String
        Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
        (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
        ByVal lpReturnedString$, ByVal nSize&) As Long
     
        Public Declare Function WriteProfileString Lib "kernel32" Alias _
        "WriteProfileStringA" (ByVal lpszSection$, ByVal lpszKeyName$, _
        ByVal lpszString$) As Long
     
     
     
    subCreatePDFFromReport "etEmail etEmail", "J:\Hr\Régies\Test\pdf\etEmail.pdf"
    End Sub
     
    Private Sub ValidationEntreprises_Click()
    'Traitement des erreurs
    On Error GoTo Err_ValidationEntreprises_Click
     
    'Lancement de la requete qui vide la table tbl_Maisons
    DoCmd.OpenQuery "qry_suppresion_maisons"
     
    'Lancement de la requête qui ajoute les entreprises cochées à la table tbl_Maisons
    DoCmd.OpenQuery "qry_Remplir_maisons"
     
    Exit_ValidationEntreprises_Click:
        Exit Sub
     
    'Affiche un message avec la description de l'erreur et quitte la fonction
    Err_ValidationEntreprises_Click:
        MsgBox Err.Description
        Resume Exit_ValidationEntreprises_Click
    End Sub
     
     
        Public Function fnctGetDefaultPrinter() As String
    'L'ensemble du code ci-dessous est destiné à être utilisé avec PDFWriter d' Acrobat.
    'De plus, l'installation d'Acrobat doit être faite en mode personnalisé afin de cocher la case PDFWriter
    'qui n'est pas installé en mode Par défaut.
     
    'Obtention et définition temporaire dynamique des paramètres d'impression:
    Dim nSize As Integer
    Dim strPrinterName As String
    Dim successReturn&
    Dim iPos1 As Integer, iPos2 As Integer
        nSize = 81
        strPrinterName = Space(nSize)
            successReturn = GetProfileString("windows", "device", _
                      vbNullString, strPrinterName, nSize)
            strPrinterName = Left(strPrinterName, successReturn)
            iPos1 = InStr(1, strPrinterName, ",")
            iPos2 = InStr(iPos1 + 1, strPrinterName, ",")
        strPrinterName = Left(strPrinterName, iPos1 - 1)
        fnctGetDefaultPrinter = strPrinterName
    End Function
     
    Private Sub subGetDriverAndPort(ByVal Buffer As String, _
      ByRef DriverName As String, ByRef PrinterPort As String)
     
    Dim posDriver As Integer
    Dim posPort As Integer
     
      DriverName = vbNullString
      PrinterPort = vbNullString
      posDriver = InStr(Buffer, ",")
      If posDriver > 0 Then
        DriverName = Left(Buffer, posDriver - 1)
        posPort = InStr(posDriver + 1, Buffer, ",")
        If posPort > 0 Then
            PrinterPort = Mid(Buffer, posDriver + 1, posPort - posDriver - 1)
        End If
      End If
    End Sub
     
    Private Sub SetDefaultPrinter(ByVal PrinterName As String)
    Dim Buffer As String
    Dim DeviceName As String
    Dim DriverName As String
    Dim PrinterPort As String
    Dim DeviceLine As String
      Buffer = Space(1024)
      Call GetProfileString("PrinterPorts", PrinterName, vbNullString, _
          Buffer, Len(Buffer))
      subGetDriverAndPort Buffer, DriverName, PrinterPort
      If DriverName <> vbNullString And PrinterPort <> vbNullString Then
        DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
        Call WriteProfileString("windows", "Device", DeviceLine)
      End If
    End Sub
     
    'Creation du pdf
    Private Sub subCreatePDFFromReport(ByVal ReportName As String, _
      ByVal PDFFileName As String)
      originalPrinter = fnctGetDefaultPrinter()
      SetDefaultPrinter "Acrobat PDFWriter"
      subRegistrySetKeyValue rootHKeyCurrentUser, _
       "Software\Adobe\Acrobat PDFWriter\", "PDFFileName", _
         PDFFileName, RRKREGSZ
     
      DoCmd.OpenReport ReportName, 0
      SetDefaultPrinter originalPrinter
    End Sub

  4. #4
    Expert éminent
    Avatar de cafeine
    Inscrit en
    Juin 2002
    Messages
    3 904
    Détails du profil
    Informations forums :
    Inscription : Juin 2002
    Messages : 3 904
    Points : 6 781
    Points
    6 781
    Par défaut
    Hello,

    déjà les déclarations API se mettent en tête de module et JAMAIS à l'intérieur d'une Sub ou d'une Function

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
        'Declaration des fonctions
        Private originalPrinter As String
        Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
        (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
        ByVal lpReturnedString$, ByVal nSize&) As Long
     
        Public Declare Function WriteProfileString Lib "kernel32" Alias _
        "WriteProfileStringA" (ByVal lpszSection$, ByVal lpszKeyName$, _
        ByVal lpszString$) As Long
    Ne mettez pas "Problème" dans vos titres, par définition derrière toute question se cache un problème
    12 tutoriels Access



  5. #5
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut Declaration
    Bonjour,

    J'ai fait cette modification mais j'ai toujours le même message d'erreur.

  6. #6
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut Message d'erreur
    Bonjour,

    Le message d'erreur qui apparait est le suivant :

    L'expression Sur clic entrée comme paramètre de la propriété de type évènement est à l'origine d'une erreur. Des constantes, chaînes de longueur fixe, tableaux, types définis par l'utilisateur et instructions Declare ne sont pas autorisés comme membres Public de modules objet.

    *Le résultat de l'expression n'est pas le nom d'une macro, le nom d'une fonction définie par l'utilisateur ou [Event Procedure]
    *Une erreur a peut-être été commise lors de l'évaluation d'une fonction, d'un évènement ou d'une macro.


    Voici le code que j'ais actuellement :

    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
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    Option Compare Database
    Option Explicit
     
     
        'Declaration des fonctions
        Private originalPrinter As String
        Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
        (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
        ByVal lpReturnedString$, ByVal nSize&) As Long
     
        Public Declare Function WriteProfileString Lib "kernel32" Alias _
        "WriteProfileStringA" (ByVal lpszSection$, ByVal lpszKeyName$, _
        ByVal lpszString$) As Long
     
    Private Sub buEnvoiMail2_Click()
     
    On Error Resume Next
     
    'Déclaration dea variables
        Dim db As DAO.Database, qry As QueryDef
        Dim rs As DAO.Recordset
        Dim req As DAO.Recordset
        Dim mail, erreur As String
        Dim Entreprise As String
     
     
     
        Set db = CurrentDb
        'contrôle si la requête ReqEmail existe si non on la créé
        Set qry = db.QueryDefs("ReqEmail")
        If Err.Number <> 0 Then
            Set qry = db.CreateQueryDef("ReqEmail")
            Err.Clear
        End If
     
        'Selection des nom et adresses email des entreprises
        'J'ai créé une nouvelle table car la personne qui a créé la table d'orginine a mis des espaces dans le nom!!!!!!
        Set rs = CurrentDb.OpenRecordset("SELECT [tbl_Maisons].Entreprise, [tbl_Maisons].[EMail] FROM [tbl_Maisons];")
     
        'Boucle qui passe en revue toutes les entreprises
        While Not rs.EOF
        'Création de la requête avec les variables de l'entreprise en cours...
            qry.SQL = "PARAMETERS semaine Value;" & _
            " SELECT Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine,[tbl_Maisons].N° AS Code," & _
            " [tbl_Maisons].Entreprise, Last(Regie_base2.Branche) AS DernierDeBranche, Last([tbl_Maisons].Nom) AS Reference, Last([tbl_Maisons].Rue) AS DernierDeRue," & _
            " Last([tbl_Maisons].Npa) AS DernierDeNpa, Last([tbl_Maisons].Ville) AS DernierDeVille, Last([tbl_Maisons].Fax) AS DernierDeFax, Last(Regie_base2.Qualite) AS DernierDeQualite, " & _
            " Last(Regie_horaire.Matricule) AS DernierDeMatricule, Last(Regie_base2.Nom) AS DernierDeNom, Last(Regie_base2.Prenom) AS DernierDePrenom, Last(Regie_base2.Centre_cout) AS DernierDeCentre_cout," & _
            " Last([Rqt_base_Analyse croisée].[Total de Heures]) AS [DernierDeTotal de Heures], Last(Regie_base2.Tarif) AS DernierDeTarif, Last(([Total de Heures]*[Tarif])) AS Montant, [Rqt_base_Analyse croisée].lun," & _
            " [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " FROM ([Rqt_base_Analyse croisée] LEFT JOIN Regie_horaire ON [Rqt_base_Analyse croisée].Matricule = Regie_horaire.Matricule) LEFT JOIN (Regie_base2 LEFT JOIN [tbl_Maisons] ON Regie_base2.Code = [tbl_Maisons].N°)" & _
            " ON [Rqt_base_Analyse croisée].Matricule = Regie_base2.Matricule" & _
            " WHERE [tbl_Maisons].Entreprise = " & Chr(34) & rs("Entreprise") & Chr(34) & _
            " GROUP BY Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine, [tbl_Maisons].N°, [tbl_Maisons].Entreprise, [Rqt_base_Analyse croisée].lun, [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " HAVING (((Regie_base2.Societe) = 'cimo') And (([Rqt_base_Analyse croisée].semaine) = [semaine]))" & _
            " ORDER BY [tbl_Maisons].Entreprise DESC;"
     
            'La variable entreprise prend le nom de l'entreprise en cours
            Entreprise = rs("Entreprise")
     
            'La variable mail prend l'email de l'entreprise en cours
            mail = rs("EMail")
     
            'test pour savoir s'il existe une adresse email
            If (mail <> "") Then
            'envoi de l'état en format snp à l'adresse email correspondant
            DoCmd.SendObject acReport, "etEmail", acFormatSNP, mail, , , , Chr(10) & Chr(10) & "Si vous n'arrivez pas à ouvrir le document, vous pouvez télécharger le programme a cette adresse :" & Chr(10) & "http://www.microsoft.com/downloads/details.aspx?familyid=b73df33f-6d74-423d-8274-8b7e6313edfb&displaylang=fr "
     
            'si l'entreprise n'a pas d'adresse email un message d'erreur s'affiche
            Else
            erreur = MsgBox("Il n'y a pas d'adresse email pour l'entreprise :" & Entreprise, vbOKOnly, "Email invalide")
            End If
     
            'En cas d'annulation de l'utilisateur on passe à l'entreprise suivante
            On Error Resume Next
     
            rs.MoveNext
        Wend
    rs.Close
    Set rs = Nothing
    Set db = Nothing
     
    erreur:
    MsgBox "Le mail n'a pas été envoyé", , "Action annulée"
    Exit Sub
     
    End Sub
     
     
    Private Sub ImprimerPDF_Click()
    subCreatePDFFromReport "etEmail etEmail", "J:\Hr\Régies\Test\pdf\etEmail.pdf"
    End Sub
     
    Private Sub ValidationEntreprises_Click()
    'Traitement des erreurs
    On Error GoTo Err_ValidationEntreprises_Click
     
    'Lancement de la requete qui vide la table tbl_Maisons
    DoCmd.OpenQuery "qry_suppresion_maisons"
     
    'Lancement de la requête qui ajoute les entreprises cochées à la table tbl_Maisons
    DoCmd.OpenQuery "qry_Remplir_maisons"
     
    Exit_ValidationEntreprises_Click:
        Exit Sub
     
    'Affiche un message avec la description de l'erreur et quitte la fonction
    Err_ValidationEntreprises_Click:
        MsgBox Err.Description
        Resume Exit_ValidationEntreprises_Click
    End Sub
     
     
        Public Function fnctGetDefaultPrinter() As String
    'L'ensemble du code ci-dessous est destiné à être utilisé avec PDFWriter d' Acrobat.
    'De plus, l'installation d'Acrobat doit être faite en mode personnalisé afin de cocher la case PDFWriter
    'qui n'est pas installé en mode Par défaut.
     
    'Obtention et définition temporaire dynamique des paramètres d'impression:
    Dim nSize As Integer
    Dim strPrinterName As String
    Dim successReturn&
    Dim iPos1 As Integer, iPos2 As Integer
        nSize = 81
        strPrinterName = Space(nSize)
            successReturn = GetProfileString("windows", "device", _
                      vbNullString, strPrinterName, nSize)
            strPrinterName = Left(strPrinterName, successReturn)
            iPos1 = InStr(1, strPrinterName, ",")
            iPos2 = InStr(iPos1 + 1, strPrinterName, ",")
        strPrinterName = Left(strPrinterName, iPos1 - 1)
        fnctGetDefaultPrinter = strPrinterName
    End Function
     
    Private Sub subGetDriverAndPort(ByVal Buffer As String, _
      ByRef DriverName As String, ByRef PrinterPort As String)
     
    Dim posDriver As Integer
    Dim posPort As Integer
     
      DriverName = vbNullString
      PrinterPort = vbNullString
      posDriver = InStr(Buffer, ",")
      If posDriver > 0 Then
        DriverName = Left(Buffer, posDriver - 1)
        posPort = InStr(posDriver + 1, Buffer, ",")
        If posPort > 0 Then
            PrinterPort = Mid(Buffer, posDriver + 1, posPort - posDriver - 1)
        End If
      End If
    End Sub
     
    Private Sub SetDefaultPrinter(ByVal PrinterName As String)
    Dim Buffer As String
    Dim DeviceName As String
    Dim DriverName As String
    Dim PrinterPort As String
    Dim DeviceLine As String
      Buffer = Space(1024)
      Call GetProfileString("PrinterPorts", PrinterName, vbNullString, _
          Buffer, Len(Buffer))
      subGetDriverAndPort Buffer, DriverName, PrinterPort
      If DriverName <> vbNullString And PrinterPort <> vbNullString Then
        DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
        Call WriteProfileString("windows", "Device", DeviceLine)
      End If
    End Sub
     
    'Creation du pdf
    Private Sub subCreatePDFFromReport(ByVal ReportName As String, _
      ByVal PDFFileName As String)
      originalPrinter = fnctGetDefaultPrinter()
      SetDefaultPrinter "Acrobat PDFWriter"
      subRegistrySetKeyValue rootHKeyCurrentUser, _
       "Software\Adobe\Acrobat PDFWriter\", "PDFFileName", _
         PDFFileName, RRKREGSZ
     
      DoCmd.OpenReport ReportName, 0
      SetDefaultPrinter originalPrinter
    End Sub

  7. #7
    Expert éminent
    Avatar de cafeine
    Inscrit en
    Juin 2002
    Messages
    3 904
    Détails du profil
    Informations forums :
    Inscription : Juin 2002
    Messages : 3 904
    Points : 6 781
    Points
    6 781
    Par défaut
    Juste une question bête, as-tu correctement installé Acrobat Writer ?
    Ne mettez pas "Problème" dans vos titres, par définition derrière toute question se cache un problème
    12 tutoriels Access



  8. #8
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut Acrobat Writer
    Oui,

    J'ai déjà converti plusieurs documents en pdf et ça marche niquel.

  9. #9
    Expert éminent sénior

    Avatar de Tofalu
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Octobre 2004
    Messages
    9 501
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Octobre 2004
    Messages : 9 501
    Points : 32 311
    Points
    32 311
    Par défaut
    Comme te l'indique le message d'erreur, déclare les API en private au lieu de Public

  10. #10
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut Déclaration des fonctions
    J'ai fait ce changemant mais toujours le même message d'erreur !

    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
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    Option Compare Database
    Option Explicit
     
     
        'Declaration des fonctions
        Private originalPrinter As String
        Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
        (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
        ByVal lpReturnedString$, ByVal nSize&) As Long
     
        Private Declare Function WriteProfileString Lib "kernel32" Alias _
        "WriteProfileStringA" (ByVal lpszSection$, ByVal lpszKeyName$, _
        ByVal lpszString$) As Long
     
    Private Sub buEnvoiMail2_Click()
     
    On Error Resume Next
     
    'Déclaration dea variables
        Dim db As DAO.Database, qry As QueryDef
        Dim rs As DAO.Recordset
        Dim req As DAO.Recordset
        Dim mail, erreur As String
        Dim Entreprise As String
     
     
     
        Set db = CurrentDb
        'contrôle si la requête ReqEmail existe si non on la créé
        Set qry = db.QueryDefs("ReqEmail")
        If Err.Number <> 0 Then
            Set qry = db.CreateQueryDef("ReqEmail")
            Err.Clear
        End If
     
        'Selection des nom et adresses email des entreprises
        'J'ai créé une nouvelle table car la personne qui a créé la table d'orginine a mis des espaces dans le nom!!!!!!
        Set rs = CurrentDb.OpenRecordset("SELECT [tbl_Maisons].Entreprise, [tbl_Maisons].[EMail] FROM [tbl_Maisons];")
     
        'Boucle qui passe en revue toutes les entreprises
        While Not rs.EOF
        'Création de la requête avec les variables de l'entreprise en cours...
            qry.SQL = "PARAMETERS semaine Value;" & _
            " SELECT Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine,[tbl_Maisons].N° AS Code," & _
            " [tbl_Maisons].Entreprise, Last(Regie_base2.Branche) AS DernierDeBranche, Last([tbl_Maisons].Nom) AS Reference, Last([tbl_Maisons].Rue) AS DernierDeRue," & _
            " Last([tbl_Maisons].Npa) AS DernierDeNpa, Last([tbl_Maisons].Ville) AS DernierDeVille, Last([tbl_Maisons].Fax) AS DernierDeFax, Last(Regie_base2.Qualite) AS DernierDeQualite, " & _
            " Last(Regie_horaire.Matricule) AS DernierDeMatricule, Last(Regie_base2.Nom) AS DernierDeNom, Last(Regie_base2.Prenom) AS DernierDePrenom, Last(Regie_base2.Centre_cout) AS DernierDeCentre_cout," & _
            " Last([Rqt_base_Analyse croisée].[Total de Heures]) AS [DernierDeTotal de Heures], Last(Regie_base2.Tarif) AS DernierDeTarif, Last(([Total de Heures]*[Tarif])) AS Montant, [Rqt_base_Analyse croisée].lun," & _
            " [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " FROM ([Rqt_base_Analyse croisée] LEFT JOIN Regie_horaire ON [Rqt_base_Analyse croisée].Matricule = Regie_horaire.Matricule) LEFT JOIN (Regie_base2 LEFT JOIN [tbl_Maisons] ON Regie_base2.Code = [tbl_Maisons].N°)" & _
            " ON [Rqt_base_Analyse croisée].Matricule = Regie_base2.Matricule" & _
            " WHERE [tbl_Maisons].Entreprise = " & Chr(34) & rs("Entreprise") & Chr(34) & _
            " GROUP BY Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine, [tbl_Maisons].N°, [tbl_Maisons].Entreprise, [Rqt_base_Analyse croisée].lun, [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " HAVING (((Regie_base2.Societe) = 'cimo') And (([Rqt_base_Analyse croisée].semaine) = [semaine]))" & _
            " ORDER BY [tbl_Maisons].Entreprise DESC;"
     
            'La variable entreprise prend le nom de l'entreprise en cours
            Entreprise = rs("Entreprise")
     
            'La variable mail prend l'email de l'entreprise en cours
            mail = rs("EMail")
     
            'test pour savoir s'il existe une adresse email
            If (mail <> "") Then
            'envoi de l'état en format snp à l'adresse email correspondant
            DoCmd.SendObject acReport, "etEmail", acFormatSNP, mail, , , , Chr(10) & Chr(10) & "Si vous n'arrivez pas à ouvrir le document, vous pouvez télécharger le programme a cette adresse :" & Chr(10) & "http://www.microsoft.com/downloads/details.aspx?familyid=b73df33f-6d74-423d-8274-8b7e6313edfb&displaylang=fr "
     
            'si l'entreprise n'a pas d'adresse email un message d'erreur s'affiche
            Else
            erreur = MsgBox("Il n'y a pas d'adresse email pour l'entreprise :" & Entreprise, vbOKOnly, "Email invalide")
            End If
     
            'En cas d'annulation de l'utilisateur on passe à l'entreprise suivante
            On Error Resume Next
     
            rs.MoveNext
        Wend
    rs.Close
    Set rs = Nothing
    Set db = Nothing
     
    erreur:
    MsgBox "Le mail n'a pas été envoyé", , "Action annulée"
    Exit Sub
     
    End Sub
     
     
    Private Sub ImprimerPDF_Click()
    subCreatePDFFromReport "etEmail etEmail", "J:\Hr\Régies\Test\pdf\etEmail.pdf"
    End Sub
     
    Private Sub ValidationEntreprises_Click()
    'Traitement des erreurs
    On Error GoTo Err_ValidationEntreprises_Click
     
    'Lancement de la requete qui vide la table tbl_Maisons
    DoCmd.OpenQuery "qry_suppresion_maisons"
     
    'Lancement de la requête qui ajoute les entreprises cochées à la table tbl_Maisons
    DoCmd.OpenQuery "qry_Remplir_maisons"
     
    Exit_ValidationEntreprises_Click:
        Exit Sub
     
    'Affiche un message avec la description de l'erreur et quitte la fonction
    Err_ValidationEntreprises_Click:
        MsgBox Err.Description
        Resume Exit_ValidationEntreprises_Click
    End Sub
     
     
        Private Function fnctGetDefaultPrinter() As String
    'L'ensemble du code ci-dessous est destiné à être utilisé avec PDFWriter d' Acrobat.
    'De plus, l'installation d'Acrobat doit être faite en mode personnalisé afin de cocher la case PDFWriter
    'qui n'est pas installé en mode Par défaut.
     
    'Obtention et définition temporaire dynamique des paramètres d'impression:
    Dim nSize As Integer
    Dim strPrinterName As String
    Dim successReturn&
    Dim iPos1 As Integer, iPos2 As Integer
        nSize = 81
        strPrinterName = Space(nSize)
            successReturn = GetProfileString("windows", "device", _
                      vbNullString, strPrinterName, nSize)
            strPrinterName = Left(strPrinterName, successReturn)
            iPos1 = InStr(1, strPrinterName, ",")
            iPos2 = InStr(iPos1 + 1, strPrinterName, ",")
        strPrinterName = Left(strPrinterName, iPos1 - 1)
        fnctGetDefaultPrinter = strPrinterName
    End Function
     
    Private Sub subGetDriverAndPort(ByVal Buffer As String, _
      ByRef DriverName As String, ByRef PrinterPort As String)
     
    Dim posDriver As Integer
    Dim posPort As Integer
     
      DriverName = vbNullString
      PrinterPort = vbNullString
      posDriver = InStr(Buffer, ",")
      If posDriver > 0 Then
        DriverName = Left(Buffer, posDriver - 1)
        posPort = InStr(posDriver + 1, Buffer, ",")
        If posPort > 0 Then
            PrinterPort = Mid(Buffer, posDriver + 1, posPort - posDriver - 1)
        End If
      End If
    End Sub
     
    Private Sub SetDefaultPrinter(ByVal PrinterName As String)
    Dim Buffer As String
    Dim DeviceName As String
    Dim DriverName As String
    Dim PrinterPort As String
    Dim DeviceLine As String
      Buffer = Space(1024)
      Call GetProfileString("PrinterPorts", PrinterName, vbNullString, _
          Buffer, Len(Buffer))
      subGetDriverAndPort Buffer, DriverName, PrinterPort
      If DriverName <> vbNullString And PrinterPort <> vbNullString Then
        DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
        Call WriteProfileString("windows", "Device", DeviceLine)
      End If
    End Sub
     
    'Creation du pdf
    Private Sub subCreatePDFFromReport(ByVal ReportName As String, _
      ByVal PDFFileName As String)
      originalPrinter = fnctGetDefaultPrinter()
      SetDefaultPrinter "Acrobat PDFWriter"
      subRegistrySetKeyValue rootHKeyCurrentUser, _
       "Software\Adobe\Acrobat PDFWriter\", "PDFFileName", _
         PDFFileName, RRKREGSZ
     
      DoCmd.OpenReport ReportName, 0
      SetDefaultPrinter originalPrinter
    End Sub

  11. #11
    Expert éminent sénior

    Avatar de Tofalu
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Octobre 2004
    Messages
    9 501
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Octobre 2004
    Messages : 9 501
    Points : 32 311
    Points
    32 311
    Par défaut
    GetProfileString est encore publique

  12. #12
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut Autre erreur
    Cette fois il y a une autre erreur :

    On me dit que la variable rootHKeyCurrentUser n'est pas définie...


    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
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    Option Compare Database
    Option Explicit
    
    
        'Declaration des fonctions
        Private originalPrinter As String
        Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
        (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpDefault$, _
        ByVal lpReturnedString$, ByVal nSize&) As Long
     
        Private Declare Function WriteProfileString Lib "kernel32" Alias _
        "WriteProfileStringA" (ByVal lpszSection$, ByVal lpszKeyName$, _
        ByVal lpszString$) As Long
    
    Private Sub buEnvoiMail2_Click()
    
    On Error Resume Next
    
    'Déclaration dea variables
        Dim db As DAO.Database, qry As QueryDef
        Dim rs As DAO.Recordset
        Dim req As DAO.Recordset
        Dim mail, erreur As String
        Dim Entreprise As String
        
            
        
        Set db = CurrentDb
        'contrôle si la requête ReqEmail existe si non on la créé
        Set qry = db.QueryDefs("ReqEmail")
        If Err.Number <> 0 Then
            Set qry = db.CreateQueryDef("ReqEmail")
            Err.Clear
        End If
    
        'Selection des nom et adresses email des entreprises
        'J'ai créé une nouvelle table car la personne qui a créé la table d'orginine a mis des espaces dans le nom!!!!!!
        Set rs = CurrentDb.OpenRecordset("SELECT [tbl_Maisons].Entreprise, [tbl_Maisons].[EMail] FROM [tbl_Maisons];")
        
        'Boucle qui passe en revue toutes les entreprises
        While Not rs.EOF
        'Création de la requête avec les variables de l'entreprise en cours...
            qry.SQL = "PARAMETERS semaine Value;" & _
            " SELECT Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine,[tbl_Maisons].N° AS Code," & _
            " [tbl_Maisons].Entreprise, Last(Regie_base2.Branche) AS DernierDeBranche, Last([tbl_Maisons].Nom) AS Reference, Last([tbl_Maisons].Rue) AS DernierDeRue," & _
            " Last([tbl_Maisons].Npa) AS DernierDeNpa, Last([tbl_Maisons].Ville) AS DernierDeVille, Last([tbl_Maisons].Fax) AS DernierDeFax, Last(Regie_base2.Qualite) AS DernierDeQualite, " & _
            " Last(Regie_horaire.Matricule) AS DernierDeMatricule, Last(Regie_base2.Nom) AS DernierDeNom, Last(Regie_base2.Prenom) AS DernierDePrenom, Last(Regie_base2.Centre_cout) AS DernierDeCentre_cout," & _
            " Last([Rqt_base_Analyse croisée].[Total de Heures]) AS [DernierDeTotal de Heures], Last(Regie_base2.Tarif) AS DernierDeTarif, Last(([Total de Heures]*[Tarif])) AS Montant, [Rqt_base_Analyse croisée].lun," & _
            " [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " FROM ([Rqt_base_Analyse croisée] LEFT JOIN Regie_horaire ON [Rqt_base_Analyse croisée].Matricule = Regie_horaire.Matricule) LEFT JOIN (Regie_base2 LEFT JOIN [tbl_Maisons] ON Regie_base2.Code = [tbl_Maisons].N°)" & _
            " ON [Rqt_base_Analyse croisée].Matricule = Regie_base2.Matricule" & _
            " WHERE [tbl_Maisons].Entreprise = " & Chr(34) & rs("Entreprise") & Chr(34) & _
            " GROUP BY Regie_base2.Societe, [Rqt_base_Analyse croisée].semaine, [tbl_Maisons].N°, [tbl_Maisons].Entreprise, [Rqt_base_Analyse croisée].lun, [Rqt_base_Analyse croisée].mar, [Rqt_base_Analyse croisée].mer, [Rqt_base_Analyse croisée].jeu, [Rqt_base_Analyse croisée].ven, [Rqt_base_Analyse croisée].sam, [Rqt_base_Analyse croisée].dim" & _
            " HAVING (((Regie_base2.Societe) = 'cimo') And (([Rqt_base_Analyse croisée].semaine) = [semaine]))" & _
            " ORDER BY [tbl_Maisons].Entreprise DESC;"
                         
            'La variable entreprise prend le nom de l'entreprise en cours
            Entreprise = rs("Entreprise")
            
            'La variable mail prend l'email de l'entreprise en cours
            mail = rs("EMail")
                   
            'test pour savoir s'il existe une adresse email
            If (mail <> "") Then
            'envoi de l'état en format snp à l'adresse email correspondant
            DoCmd.SendObject acReport, "etEmail", acFormatSNP, mail, , , , Chr(10) & Chr(10) & "Si vous n'arrivez pas à ouvrir le document, vous pouvez télécharger le programme a cette adresse :" & Chr(10) & "http://www.microsoft.com/downloads/details.aspx?familyid=b73df33f-6d74-423d-8274-8b7e6313edfb&displaylang=fr "
            
            'si l'entreprise n'a pas d'adresse email un message d'erreur s'affiche
            Else
            erreur = MsgBox("Il n'y a pas d'adresse email pour l'entreprise :" & Entreprise, vbOKOnly, "Email invalide")
            End If
            
            'En cas d'annulation de l'utilisateur on passe à l'entreprise suivante
            On Error Resume Next
           
            rs.MoveNext
        Wend
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    erreur:
    MsgBox "Le mail n'a pas été envoyé", , "Action annulée"
    Exit Sub
    
    End Sub
    
    
    Private Sub ImprimerPDF_Click()
    subCreatePDFFromReport "etEmail etEmail", "J:\Hr\Régies\Test\pdf\etEmail.pdf"
    End Sub
    
    Private Sub ValidationEntreprises_Click()
    'Traitement des erreurs
    On Error GoTo Err_ValidationEntreprises_Click
    
    'Lancement de la requete qui vide la table tbl_Maisons
    DoCmd.OpenQuery "qry_suppresion_maisons"
    
    'Lancement de la requête qui ajoute les entreprises cochées à la table tbl_Maisons
    DoCmd.OpenQuery "qry_Remplir_maisons"
    
    Exit_ValidationEntreprises_Click:
        Exit Sub
        
    'Affiche un message avec la description de l'erreur et quitte la fonction
    Err_ValidationEntreprises_Click:
        MsgBox Err.Description
        Resume Exit_ValidationEntreprises_Click
    End Sub
    
    
        Private Function fnctGetDefaultPrinter() As String
    'L'ensemble du code ci-dessous est destiné à être utilisé avec PDFWriter d' Acrobat.
    'De plus, l'installation d'Acrobat doit être faite en mode personnalisé afin de cocher la case PDFWriter
    'qui n'est pas installé en mode Par défaut.
    
    'Obtention et définition temporaire dynamique des paramètres d'impression:
    Dim nSize As Integer
    Dim strPrinterName As String
    Dim successReturn&
    Dim iPos1 As Integer, iPos2 As Integer
        nSize = 81
        strPrinterName = Space(nSize)
            successReturn = GetProfileString("windows", "device", _
                      vbNullString, strPrinterName, nSize)
            strPrinterName = Left(strPrinterName, successReturn)
            iPos1 = InStr(1, strPrinterName, ",")
            iPos2 = InStr(iPos1 + 1, strPrinterName, ",")
        strPrinterName = Left(strPrinterName, iPos1 - 1)
        fnctGetDefaultPrinter = strPrinterName
    End Function
    
    Private Sub subGetDriverAndPort(ByVal Buffer As String, _
      ByRef DriverName As String, ByRef PrinterPort As String)
    
    Dim posDriver As Integer
    Dim posPort As Integer
        
      DriverName = vbNullString
      PrinterPort = vbNullString
      posDriver = InStr(Buffer, ",")
      If posDriver > 0 Then
        DriverName = Left(Buffer, posDriver - 1)
        posPort = InStr(posDriver + 1, Buffer, ",")
        If posPort > 0 Then
            PrinterPort = Mid(Buffer, posDriver + 1, posPort - posDriver - 1)
        End If
      End If
    End Sub
    
    Private Sub SetDefaultPrinter(ByVal PrinterName As String)
    Dim Buffer As String
    Dim DeviceName As String
    Dim DriverName As String
    Dim PrinterPort As String
    Dim DeviceLine As String
      Buffer = Space(1024)
      Call GetProfileString("PrinterPorts", PrinterName, vbNullString, _
          Buffer, Len(Buffer))
      subGetDriverAndPort Buffer, DriverName, PrinterPort
      If DriverName <> vbNullString And PrinterPort <> vbNullString Then
        DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
        Call WriteProfileString("windows", "Device", DeviceLine)
      End If
    End Sub
    
    'Creation du pdf
    Private Sub subCreatePDFFromReport(ByVal ReportName As String, _
      ByVal PDFFileName As String)
      originalPrinter = fnctGetDefaultPrinter()
      SetDefaultPrinter "Acrobat PDFWriter"
      subRegistrySetKeyValue rootHKeyCurrentUser, _
       "Software\Adobe\Acrobat PDFWriter\", "PDFFileName", _
         PDFFileName, RRKREGSZ
    
      DoCmd.OpenReport ReportName, 0
      SetDefaultPrinter originalPrinter
    End Sub

  13. #13
    Expert éminent
    Avatar de cafeine
    Inscrit en
    Juin 2002
    Messages
    3 904
    Détails du profil
    Informations forums :
    Inscription : Juin 2002
    Messages : 3 904
    Points : 6 781
    Points
    6 781
    Par défaut
    Merci de lire jusqu'à la fin l'article de Argyronet :
    http://access.developpez.com/sources...Etat#ExportPDF

    Tu verras tout ce qu'il manque à ton code.
    Ne mettez pas "Problème" dans vos titres, par définition derrière toute question se cache un problème
    12 tutoriels Access



  14. #14
    Candidat au Club
    Profil pro
    Inscrit en
    Décembre 2006
    Messages
    9
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : Décembre 2006
    Messages : 9
    Points : 3
    Points
    3
    Par défaut
    Le code fonctionne.

    Merci beaucoup pour votre aide.

    Luis

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

Discussions similaires

  1. [XL-2007] envoyer des feuilles xls par mail sous format pdf
    Par Nico642 dans le forum Excel
    Réponses: 0
    Dernier message: 09/01/2014, 22h45
  2. [IP-2003] Enregistrement et envois par mail en format PDF
    Par Merioty dans le forum InfoPath
    Réponses: 3
    Dernier message: 04/06/2013, 15h11
  3. Envoi d'un Etat par mail
    Par apprentiing dans le forum IHM
    Réponses: 2
    Dernier message: 15/06/2011, 11h54
  4. [AC-2003] envois d'un etat par mail
    Par revemane dans le forum IHM
    Réponses: 1
    Dernier message: 10/03/2011, 15h55
  5. envoi d'un etat par mail mais avec une variable
    Par franckserpico dans le forum Access
    Réponses: 4
    Dernier message: 28/02/2007, 15h03

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