Liste déroulante et connexion multiple à une base de données

Bonjour,

Je travaille sur un rapport Excel avec VBA et une connexion sql vers un serveur de base de données (3 serveurs différents). J'aimerais savoir comment utiliser une liste déroulante pour changer la connexion avec le serveur (j'en ai 3). J'ai mis mes 3 requêtes sql dans un onglet dans 3 lignes différentes. J'ai créé un onglet avec une table de mappage entre les éléments de liste déroulante et les serveurs de base de données.

PROGRAMS | SERVER

1 | Server1
2 | Server2
3 | Server3


L'utilisateur sélectionne le programme et entre un nombre, lorsqu'il clique sur le bouton, la chaîne de connexion est créée avec le bon serveur et la bonne requête.

Comment rendre la connexion dynamique? (Remplacez SERVER_NAME par le serveur correspondant)

voici une partie du code :

'========================================================================================
' Main module
'========================================================================================
Option Explicit

'----------------------------------------------------------------------------------------
'                                       CONSTANTS
'----------------------------------------------------------------------------------------
'SQL REQUESTS NAMES IN THE 'SQLRequests' worksheet
Public Const QUERY_FOR_SERVER1 = "QUERY_FOR_SERVER1"
Public Const QUERY_FOR_SERVER2 = "QUERY_FOR_SERVER2"
Public Const QUERY_FOR_SERVER3 = "QUERY_FOR_SERVER3"

Public Const SERVER_NAME1 = "SERVER1"
Public Const SERVER_NAME2 = "SERVER2"
Public Const SERVER_NAME3 = "SERVER3"
Public Const APPLICATION_NAME = "Report"

'SHEETS
'Public Const SHEET_NUMBER_SQL_REQUESTS As Integer = 5
Public Const SHEET_NAME_STARTHERE As String = "START HERE"
Public Const SHEET_NAME_SQL_REQUESTS As String = "SQLRequests"
Public Const SHEET_NAME_PARAMETERS As String = "STD selection"
Public Const SHEET_NAME_PARAMETERS_D As String = "NUMBER selection"
Public Const SHEET_NAME_RESULTS As String = "Data"

'SQL OPTIONS
Public Const SQL_COMMAND_TIMEOUT As Long = 900              'sql request time out in seconds (default to 30)
Public Const DB_CATALOG As String = "DATA"                  'Schema in the DATABASE where the data has to be requested


'========================================================================================
'                                                   FUNCTIONS
'========================================================================================

'-------------------------------------------------------------------
' Main function called by the 'Generate Report' button in the GUI
' to generate the report
'-------------------------------------------------------------------
Public Sub GenerateReport()
    Dim sqlQuery As String
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim resultSheet As Worksheet
    Dim i As Long
    Dim j As Long
    Dim row As Long
    Dim nStep As Long
    Dim nMax As Long
    Dim msn As String

    
    'Create or clear result sheet
    CreateOrClearSheet (SHEET_NAME_RESULTS)
    Set resultSheet = ThisWorkbook.Sheets(SHEET_NAME_RESULTS)
    
    'Get the selected NUMBER
    If (Len(ThisWorkbook.Sheets(SHEET_NAME_STARTHERE).Cells(12, 3)) > 0) Then
        msn = ThisWorkbook.Sheets(SHEET_NAME_STARTHERE).Cells(12, 3).value
        'Build the SQL request to be executed
        sqlQuery = getSqlRequest(SHEET_NAME_SQL_REQUESTS)
        'Replace ##NUMBER## token with selected MSN
        sqlQuery = Replace(sqlQuery, "##NUMBER##", Number)
    Else
        sqlQuery = getSqlRequest(PARAM_QUERY_WITHOUT_NUMBER)
    End If
    
    sqlQuery = Replace(sqlQuery, "##FAM_STDPT##", GetSTDPList)
    sqlQuery = Replace(sqlQuery, "##D_LIST##", GetDList)

    
    'Exit if sql query is empty
    If (Len(sqlQuery) = 0) Then
        MsgBox "SQL query is empty.", vbCritical
        Exit Sub
    End If
    
    'Init DB connection
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    'Open connection to the DB and execute query
    With cn
        .Provider = "sqloledb"
        .ConnectionString = "Data Source=" & SERVER_NAME & ";Initial Catalog=" & DB_CATALOG & ";Integrated Security=SSPI;Application Name=" & APPLICATION_NAME & ";"
        .ConnectionTimeout = 30
        .CommandTimeout = SQL_COMMAND_TIMEOUT
        .CursorLocation = adUseClient
        .Open
    End With
    'Open recordset
    rs.Open sqlQuery, cn
    
    ' Loading header
    For j = 1 To rs.Fields.Count
        resultSheet.Cells(1, j).value = rs.Fields(j - 1).Name
        resultSheet.Cells(1, j).Interior.Color = RGB(64, 128, 192)     'blue
        resultSheet.Cells(1, j).Font.Color = RGB(255, 255, 255)        'white
        resultSheet.Cells(1, j).Columns.AutoFit
    Next

    ' Loading data
    resultSheet.Cells(2, 1).CopyFromRecordset rs
        
    'Display the results
    resultSheet.Activate
    
    '     Length of columns autofit
     resultSheet.Range("A1:XFD10").Columns.AutoFit
    '     Length of column F fixed to 60
     resultSheet.Columns("F").ColumnWidth = 60
    
    MsgBox "Report generated successfully.", vbInformation, "Report"
    
    Exit Sub
    
End Sub


'--------------------------------------------------------------------
' Returns the SQL request corresponding to the specified parameter.
' The sql requests are stored in the 'SQLRequests' worksheet.
' Return empty string if the request is not found.
'--------------------------------------------------------------------
Private Function getSqlRequest(sParameterName As String) As String
    Dim sRequest As String
    Dim iLine As Long
    Dim wsSQLParameters As Worksheet
    
    sRequest = ""
    Set wsSQLParameters = ThisWorkbook.Sheets(SHEET_NAME_SQL_REQUESTS)
    If (Not wsSQLParameters Is Nothing) Then
        iLine = Utils.GetRowHavingValue(wsSQLParameters, 1, sParameterName)
        If (iLine > 0) Then
            sRequest = wsSQLParameters.Cells(iLine, 2).value
        Else
            MsgBox "Can't find the parameter '" & sParameterName & "' in the sheet '" & wsSQLParameters.Name & "'. Generation can't be performed.", vbCritical, "Report"
        End If
    Else
        MsgBox "Can't find the worksheet '" & SHEET_NAME_SQL_REQUESTS & "'.", vbCritical, "getSqlRequest"
    End If
    
    getSqlRequest = sRequest
End Function


'--------------------------------------------------------------------
' Apply styles to the result sheet cells.
'--------------------------------------------------------------------
Private Sub ApplyStyleToCells(sheet As Worksheet)
    If (Not sheet Is Nothing) Then
        With sheet.Cells
            .WrapText = False
            .ShrinkToFit = False
            .co
        End With
    Else
        LogWARN "Can't apply style to cells as worksheet in parameter is null."
    End If
End Sub

Je vous remercie par avance,

Slim