emplacement du renvoi des donées d'un requête

[breizhoneg]

Bonjour tout le monde.

Une fois de plus je me tourne vers la communauté pour essayer de résoudre mon petit souci...

J'utilise excel pour executer une requete sql dans une base de donnée oracle. Jusque la tout fonctionne parfaitement.

Ce qui ne me convient pas, c'est que les données de ma requête sont copié en "A1" de mon onglet "Exctraction_1". J'aimerai que les données soit copié a partie de la case "A4". Je supose que c'est possible, mais je ne comprend pas grand chose au code VBA... (c'est un colégue qui m'a fournis le code que j'utilise).

Afin d'aider ci joint le code vba que j'utilise:

Dim Session
Dim Hdb
Dim rec
Dim req As String

Sub connexion()
    ret = connect()
End Sub

Function connect() As Boolean
On Error GoTo fin
    connect = True
    Set Session = CreateObject("OracleInProcServer.XOraSession")
    base = Range("base").Value
    string_connect = Range("string_connect").Value
    Set Hdb = Session.OpenDatabase(base, string_connect, 0)
    Exit Function
fin:
    MsgBox Session.LastServerErrtext
    connect = False
End Function

Function NewReqSheet(SQL, sheet As Worksheet)

On Error GoTo fin
    NewReqSheet = True

    Application.ScreenUpdating = False
    If ExecReq(sheet, SQL, 1) > 0 Then
        Range("A4").Select
    Else
        NewReqSheet = False
        Application.DisplayAlerts = False
        Application.DisplayAlerts = True
    End If
    
    Application.ScreenUpdating = True
    Exit Function
fin:
    NewReqSheet = False
    Application.ScreenUpdating = True
End Function

Function ExecReq(sheet As Worksheet, ReqSql, Lig)
On Error GoTo fin
    ExecReq = -1
    Set rec = Hdb.dbcreateDynaset(ReqSql, 0)
    Table = ""
    ExecReq = rec.RecordCount
    If ExecReq > 0 Then
        nbCol = rec.fields.Count
        For j = 0 To nbCol - 1
            sheet.Cells(Lig, j + 1).Value = rec.fields(j).Name
        Next j
        Lig = Lig + 1
        For i = 2 To rec.RecordCount + 1
            For j = 0 To nbCol - 1
                sheet.Cells(Lig, j + 1).Value = rec.fields(j).Value
            Next j
            Lig = Lig + 1
            rec.movenext
        Next
    Else
        Application.DisplayAlerts = False
        'sheet.Delete
        Application.DisplayAlerts = True
    End If
    Exit Function
fin:
    ErrorOracle
    ExecReq = -1
End Function

Sub ErrorOracle()
On Error GoTo fin
    If Not Hdb Is Nothing Then
        If Hdb.LastServerErr <> 0 Then
            nError = Hdb.LastServerErr
            Select Case Hdb.LastServerErr
                    Case 6110
                        strErr = "Une erreur (6110) de connexion réseau s'est produite, vous devrez relancer l'application !"
                    Case Else
                        strErr = Hdb.LastServerErrtext
            End Select
            strErr = strErr & Chr(13) & QrySQL
            MsgBox strErr
            Hdb.LastServerErrReset
        End If
    Else
        If Not Session Is Nothing Then
            strErr = Session.LastServerErrtext
            MsgBox strErr
            Session.LastServerErrReset
        Else
            strErr = "Echec à la connexion, erreur Oracle inconnue !"
            MsgBox strErr
        End If
    End If
    Exit Sub
fin:
    MsgBox "Vous devez vous connecter à la Base !"
End Sub

Sub ClearSheetsVets()

' Efface le contenu des retours de requêtes
    Application.ScreenUpdating = False
    
    Sheets("Extraction_1").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    '
    'Sheets("Requetes").Select
    
    Application.ScreenUpdating = True
    
End Sub

Sub Requetesazerty()
    Dim req As String '
    
    Application.ScreenUpdating = False
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    
    ' Efface le contenu des feuilles de résultats Vet's One
    'ClearSheetsVets

    connexion
    
    ' Récupère la 1ère requête, l'affiche et l'exécute
    NbLignes = Range("Requete").Rows.Count
    req = ""
    For i = 1 To NbLignes
        req = req + Range("Requete").Cells(i).Value
    Next
    'Application.StatusBar = req
    NewReqSheet req, Worksheets("Extraction_1")

    Sheets("Requetes").Select
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
    Application.ScreenUpdating = True
    
End Sub

Merci d'avance pour votre aide.

 

[breizhoneg]

Re : emplacement du renvoi des donées d'un requête

Re bonjour le forum,

Je me permet un petit up. Peut qu'un d'entre vous aura une idée aujourd'hui?

Merci d'avance et bon weekend.