Debug code VBA Workbooks.Open

Bonjour à tous,

J'ai adapté une marco trouver sur internet pour copier des données de fichier Excels et les coller dans un fichier a part afin de les centraliser.

Sub CopyDataBetweenWorkbooks()

    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim shCurrency As Worksheet
    Dim strFilePath As String
    Dim strPath As String

    ' Initialize some variables and
    ' get the folder path that has the files
    Set shTarget = ThisWorkbook.Sheets("Summary")
    strPath = GetPath

    ' Make sure a folder was picked.
    If Not strPath = vbNullString Then

        ' Get all the files from the folder
        strfile = Dir$(strPath & "*.xlsx", vbNormal)

        Do While Not strfile = vbNullString

            'Open the file and get the source sheet
            Set wbSource = Workbooks.Open(strPath & strfile)
            Set shSource = wbSource.Sheets("Summary Sensitivity")
            Set shCurrency = wbSource.Sheets("Data")

            'Copy the data
            Call CopyData(shSource, shTarget, shCurrency)

            'Close the workbook and move to the next file.
            wbSource.Close False
            strfile = Dir$()
        Loop
    End If

End Sub

' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet, shCurrency As Worksheet)
Dim strRANGE_ADDRESS As String
Dim strRANGE_ADDRESS2 As String

    If shCurrency.Range("E13").Value = "EUR" Then
        strRANGE_ADDRESS = "B9:E9"
    Else
        strRANGE_ADDRESS = "B10:E10"
     End If

    If shCurrency.Range("E13").Value = "EUR" Then
        strRANGE_ADDRESS2 = "B28:E28"
    Else
         strRANGE_ADDRESS2 = "B29:E29"
    End If

    Dim lCol As Long
    Dim lCol2 As Long
    'Dim fname As Long
    'Determine the last column.
    lCol = shTarget.Cells(shTarget.Rows.Count, "D").End(xlUp).Row + 1
    fname = shTarget.Cells(shTarget.Rows.Count, "B").End(xlUp).Row + 1
    lCol2 = shTarget.Cells(shTarget.Rows.Count, "D").End(xlUp).Row + 2
    fname2 = shTarget.Cells(shTarget.Rows.Count, "B").End(xlUp).Row + 2
    risk1 = shTarget.Cells(shTarget.Rows.Count, "C").End(xlUp).Row + 1
    risk2 = shTarget.Cells(shTarget.Rows.Count, "C").End(xlUp).Row + 2

    'Copy the data.
    shSource.Range(strRANGE_ADDRESS).Copy
    shTarget.Cells(lCol, "D").PasteSpecial xlPasteValues
    shTarget.Cells(fname, "B") = shSource.Parent.Name
    shTarget.Cells(risk1, "C") = "+10 bps"

    shSource.Range(strRANGE_ADDRESS2).Copy
    shTarget.Cells(lCol2, "D").PasteSpecial xlPasteValues
    shTarget.Cells(fname2, "B") = shSource.Parent.Name
    shTarget.Cells(risk2, "C") = "-10 bps"

    ' Reset the clipboard.
    Application.CutCopyMode = xlCopy

End Sub

' Fucntion to get the folder path
Function GetPath() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Select a folder"
        .Title = "Folder Picker"
        .AllowMultiSelect = False

        'Get the folder if the user does not hot cancel
        If .Show Then GetPath = .SelectedItems(1) & "\"

    End With

End Function

Cependant une fois sur deux la marco bug a cette endroit :

"Set wbSource = Workbooks.Open(strPath & strfile)",

Savez-vous pourquoi ?

Merci,

Cordialement,

Cabouse

Bonjour,

si ton répertoire est sur le réseau, cela pourrait être dû à des problèmes réseaux ou de serveurs.

Bonjour h2so4,

Je mets les fichiers sur mon disque local pour éviter des problèmes

bonjour

et quel est alors le message d'erreur ?

Le voila

Bonjour

ajoute une instruction avant le workbooks.open

msgbox strpath & strfile

Bonjour h2so4,

Incroyable ça ne bug plus (je comprends pas pourquoi) je l'ai lancer 3 fois... par contre je suis obligé de cliquer ok a chaque fois, il n'y a pas un moyen qu'il clique sur le mdg box tout seul?

Merci,

Cordialement,

Cabouse

Bonjour,

le but de l'instruction n'était pas que cela ne bogue plus, mais d'avoir un visualisation du nom du fichier à ouvrir pour affiner le diagnostic.

si cela fonctionne ainsi on pourrait essayer de passer par une variable intermédiaire

nrf$=strpath & strfile
Set wbSource = Workbooks.Open(nrf)

Hello encore,

Ca a marché deux fois, je vais attendre demain pour réessayer peut être que cette après-midi la macro a decider de bien marché, j'attends juste demain avant de le mettre en résolu (pour être sûr).

J'ai une autre question relative à l'ouverture via .Open.

Dans mes options j'ai desactivé l'option pour demander la mise à jour des liens cependant via l'ouverture VBA il me remet :

est ce que tu sais comment desactivé cette demande ?

Merci encore à toi,

Cordialement,

Cabouse

Bonsoir,

essaie en ajoutant cette instruction avant l'open

Application.DisplayAlerts = False

et celle-ci après l'open

Application.DisplayAlerts = True

je n'ai pas pu tester.

Hello encore,

Ca n'a pas marché tout de suite, en cherchant un peu j'ai trouvé qu'il fallait faire :

        
        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
        Workbooks.Open
        Application.AskToUpdateLinks = True
        Application.DisplayAlerts = True

Merci grace à toi j'ai plus de crise d'epilepsie lorsque j'ouvre cette marco

Par contre la marco a rebugger vers la fin j'ai retester avec :

msgbox strpath & strfile

Mais elle a bien marché , je reteste demain c'est peut être un bug passager *croise les doigts*

Merci encore,

Cabouse