Comment adapter du SQL en VBA

[anthooooony]

Bonjour,

Je fais beaucoup de Tableau croisé dynamique, lié à Access ou je recupere le code SQL.

Je souhaite envoyer un rapport d'activité à plusieurs agence, et je souhaiterais que si un utilisateur de l'agence paris ait en filtre de rapport Paris, un de Lyon ait sont rapport.

J'ai trouvé un code pour lancer une macro en fonction de son identifiant Windows qui est if environ("username")
et j'ai récupéré le code que je mets dans le tableau croisé dynamique.

Je voulais savoir si ce que j'essaye de faire est possible ou un peu compliqué?

Merci d'avance

Anthoooony

Private Sub Workbook_Open()

If Environ("UserName") = "RC1194" Then

SELECT [2012].[Type pce], Sum([2012].[Montant DI]) AS [SommeDeMontant DI], Agence.[Libellé Agence]
FROM 2012 LEFT JOIN Agence ON [2012].DomA = Agence.DOMAINE
GROUP BY [2012].[Type pce], Agence.[Libellé Agence]
HAVING (((Agence.[Libellé Agence])="AGENCE PARIS"));


Or Environ("UserName") = "IBD496" Then

SELECT [2012].[Type pce], Sum([2012].[Montant DI]) AS [SommeDeMontant DI], Agence.[Libellé Agence]
FROM 2012 LEFT JOIN Agence ON [2012].DomA = Agence.DOMAINE
GROUP BY [2012].[Type pce], Agence.[Libellé Agence]
HAVING (((Agence.[Libellé Agence])="AGENCE LYON"));


Etc

 

[Jam]

Re : Comment adapter du SQL en VBA

Salut Anthony,

2 petites recommandations:
- Concernant tes requêtes, vu que tu lances la même requête plusieurs fois, je te conseille vivement de: créer la requête dans Access, puis de "l'appeler" depuis Excel en lui passant le paramètre voulu. D'une, ça t'évitera de coder le SQL, et de deux ce sera plus efficace car c'est le moteur d'Access qui fonctionnera.
- Plutôt que d'utiliser Environ(), je t'invite à regarder du côté des API, qui te permettront de lire le nom de la personne loggée et le nom de la machine.

Le code qui permet d'appeler ta requête stockée dans Access:

Option Explicit


'NB: référence à {Microsoft ActiveX Data Objetcs 2.xx Library} nécessaire pour que cela fonctionne


Private Const sProvider As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Private Const sLogin As String = ";User Id=Admin; Password"
Public oRst As ADODB.Recordset


Private Sub OpenSearch()
Dim oCmd As ADODB.Command
Dim objParams As New ADODB.Parameter
'Dim vRep As Variant
'Dim sQuery As String
Dim sConnect As String
Dim i As Integer    'Compteur
Dim myMDB As String
Dim sCon As String


    On Error GoTo GestionErreur


    ' Initialisation des variables de connexion à la BDD
    myMDB = Range("sPath")    '##### Mettre le chemin de la BDD Access dans une cellule nommée ou en dur dans le fichier.
    sCon = sProvider & myMDB & sLogin
   
    '# Création de la chaîne de connexion
    sConnect = sCon
   
    '# Création d'objet ADO Command
    Set oCmd = New ADODB.Command
   
    With oCmd
        .ActiveConnection = sConnect
        '.CommandText = sQuery
        .CommandText = '### nom de la requête dans Access
        .CommandType = adCmdStoredProc
    End With


    '# Création et ajout de(s) paramètre(s) Create and append the parameters.
    With objParams
        .Name = "mavaleur"    'nom du paramètre mis dans ta requête Access
        '.Value = "%" & vRep & "%"    '### Remplacer vRep par la variable que tu transfères ex. "RC1194". Les % sont utiles ici car j'utilise un Like dans le Query
        .Value = "RC1194"
        .Type = adVarChar    '# Point délicat ici, car il faut choisir le bon type en fonction de ton champs dans ta base
        .Size = 50
        .Direction = adParamInput
    End With


    '# Chargement des paramètres et exécution du Query
    oCmd.Parameters.Append objParams
    Set objParams = Nothing
    Set oRst = oCmd.Execute
   
    If oRst.RecordCount = 0 Then
        MsgBox "Aucun enregistrement ne correspond à cette recherche.", vbOKOnly + vbInformation, "Recherche"
        GoTo GestionErreur
    End If


    '# Recopie les noms des champs et les valeurs retournées dans la feuille cible
    With ThisWorkbook.Worksheets(1).Cells(2, 1)
        .CurrentRegion.ClearContents
        'Recopie des noms de champs
        With oRst
            For i = 0 To .Fields.Count - 1
                Cells(1, i + 1) = .Fields(i).Name
            Next
        End With
        'Copie des données dans la feuille
        .CopyFromRecordset oRst
    End With
       
GestionErreur:
    'Fermeture des connexions
    oRst.Close
    'Effacement des variables
    Set oRst = Nothing
    Set oCmd = Nothing
  
End Sub

La requête en mode SQL que j'utilise dans ma base Access (la tienne sera évidemment différente) pour bien comprendre les liens entre code VBA et base Access

SELECT t_EFFECTIFS.MATRICULE, t_EFFECTIFS.NOM_PRENOM, t_EFFECTIFS.SOCIETE, t_EFFECTIFS.REGION, t_EFFECTIFS.SITE, t_EFFECTIFS.CENTRE_ANALYSE, t_EFFECTIFS.ANNEE, t_EFFECTIFS.MOIS
FROM t_EFFECTIFS
WHERE (((t_EFFECTIFS.NOM_PRENOM) Like mavaleur) AND ((t_EFFECTIFS.NATURE_BUDGET)="réel"))
ORDER BY t_EFFECTIFS.NOM_PRENOM, t_EFFECTIFS.ANNEE DESC , t_EFFECTIFS.MOIS DESC;

Exemple pour les API, tu peux utiliser le code suivant:

'Déclaration des API utilisées
Declare Function GetComputerName Lib "kernel32" _
       Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
                 (ByVal lpBuffer As String, nSize As Long) As Long



Sub test()
     MsgBox ReturnComputerName
     MsgBxo ReturnUserName


End Sub


Function ReturnComputerName() As String
Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetComputerName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
    Else
        tString = rString
    End If
    On Error GoTo 0
    ReturnComputerName = UCase(Trim(tString))
End Function

Function GetLoginName() As String
Dim strName As String
Dim lngReturn As Long
Dim strLoginName As String


    strName = Space$(25)
    lngReturn = GetUserName(strName, 25)


    If lngReturn = 1 Then
        strLoginName = Trim(strName)
        DoEvents
        GetLoginName = strLoginName
    Else
        GetLoginName = "Impossible de récupérer le nom d'utilisateur"
    End If


End Function

Bon courage

 

[anthooooony]

Re : Comment adapter du SQL en VBA

Bonjour Jam

Je viens de tomber dans les pommes à la lecture de ta réponse

Je vais tout imprimer pour relire dans le détail pour comprendre

Merci

Anthooooony