yo

Je cherche avec le code suivant a ouvrir un fichier specifique qui est issu d'une base Access. Pour arriver a ce code, j'ai effectuee la manipulation en l'enregistrant a l'aide d'une macro, puis j'ai change les variables pour les passer en temps que globales.

Neanmoins, une erreur survient lorsque ma fonction principale essaie de retourner ActiveWorkbook: "Variable objet ou variable de bloc with non definie".

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
Function OPENPAYSMERVEILLEUXACCESS() As Workbook
    Dim Pos As Long
    Const Separateur As String = "\"
    Const PSW As String = "123"
    Const DocNameToOpen As String = "PAYSMERVEILLEUX"
    Dim DocName As String
    Dim DirectoryName As String
 
    Pos = InStrRev(PathDocAccessPaysClient, Separateur, -1)
    DocName = Mid(PathDocAccessPaysClient, Pos)
    DirectoryName = Mid(PathDocAccessPaysClient, 1, Len(PathDocAccessPaysClient) - Len(DocName))
 
    ActiveWorkbook.ActiveSheet.Copy
 
    ActiveWorkbook.Worksheets.Add
    With ActiveWorkbook.ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" + DirectoryName + "", "" + DocName + ";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path=" _
        , _
        """"";Jet OLEDB:Database Password=" + PSW + ";Jet OLEDB:Engine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2" _
        , _
        ";Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encryp" _
        , _
        "t Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        , _
        ";Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False" _
        ), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array(DocNameToOpen)
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = PathDocAccessPaysClient
        .ListObject.DisplayName = "TITREPARDEFAUT"
        .Refresh BackgroundQuery:=False
    End With
    OPENPAYSMERVEILLEUXACCESS= ActiveWorkbook
End Function
Auriez-vous une solution a mon probleme?

Merci.