Problème de compréhension d'un code simpleRésolu

Question

Bonjour,

je travaille sur un code qui a été fait par quelqu'un d'autre avant moi et étant très débutant en VBA je n'arrive pas à comprendre ce qu'il fait. Est-ce que quelqu'un pourrait me l'expliquer par étape ?

Function FileSystem(titre As String, fType As MsoFileDialogType)
    Dim fDialog As FileDialog
    Dim selectedfile As String
    Dim vrtSelectedItem As Variant

    Set fDialog = Application.FileDialog(fType)
    With fDialog
        .Title = titre
        .AllowMultiSelect = False
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                selectedfile = vrtSelectedItem
            Next vrtSelectedItem
        Else
            selectedfile = ""
        End If
    End With
    Set fDialog = Nothing
    FileSystem = selectedfile
End Function

Public Sub newreport()

    Dim fPRKS As String

    fPRKS = FileSystem("Sélection du fichier PRKS", msoFileDialogFilePicker)
    If fPRKS = "" Then
        GoTo ending
    End If

    XLSWorkingFile = Mid(Application.VBE.ActiveVBProject.Filename, _
            InStrRev(Application.VBE.ActiveVBProject.Filename, "") + 1)

    Windows(XLSWorkingFile).Activate
    
    ThisWorkbook.Worksheets("HEAD").Visible = True
    ThisWorkbook.Worksheets("HEAD").Copy After:=Worksheets(Worksheets.Count)
    ActiveWindow.ActiveSheet.Name = "Report"
    ThisWorkbook.Worksheets("HEAD").Visible = False
        
    ' Set wkbCurrency = Application.Workbooks.Open(Base_currency, UpdateLinks:=False, ReadOnly:=True)
        
    Call LoadFile(fPRKS)
    Call TransfertData

    ' Application.DisplayAlerts = False
    ' wkbCurrency.Close SaveChanges:=False
    ' Application.DisplayAlerts = True

    ThisWorkbook.Worksheets("Report").Select
    ThisWorkbook.Worksheets("Report").Cells.Select
    ThisWorkbook.Worksheets("Report").Cells.EntireColumn.AutoFit
    
    Range("A1").Select
    Sheets("Report").Select
    Sheets("Report").Name = "Report " & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hhmm")

ending:
    Exit Sub
End Sub

Sub LoadFile(fPRKS As String)
  On Error GoTo err_read_file
    Dim XLSsourceFile As String

    Workbooks.Open Filename:=fPRKS
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1) _
        , Array(40, 1), Array(41, 1)), TrailingMinusNumbers _
        :=True
        
    Columns("L:L").Select
    Range("L67").Activate
    Selection.NumberFormat = "yyyymmdd"

    Cells.Select
    Selection.Copy
    
    XLSsourceFile = Mid(fPRKS, InStrRev(fPRKS, "") + 1)
    
    Windows(XLSWorkingFile).Activate
    
    ThisWorkbook.Worksheets("PRKS").Visible = True
    ThisWorkbook.Worksheets("PRKS").Select
    ThisWorkbook.Worksheets("PRKS").Cells.Select
    ActiveSheet.Paste
    ThisWorkbook.Worksheets("PRKS").Visible = False
    Windows(XLSsourceFile).Activate

    Application.DisplayAlerts = False
    ActiveWindow.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Exit Sub
    
err_read_file:
    MsgBox Err.Description, vbExclamation, "Read File"
    Exit Sub
End Sub

Sub TransfertData()
    Dim acc_name As String, aal_alias As String, fnd_name As String, fal_alias As String, txn_txn_date As String, _
    txt_code As String, txn_units As String, fpr_unit_price As String, txn_amount As String, fund_cur_alias As String, account_cur_alias As String, _
    mc_txn_amount As String, exchange_rate As String, isin As String, mcx_txn_amount As String, acc_nsrd_sell_location As String, txt_memo As String
            
    Dim fxrate As Double
    
    Dim i As Integer, int_row_count As Integer, int_sign As Integer
    i = 1
    int_row_count = 2
    
    ThisWorkbook.Worksheets("Report").Select
    
    Do
        If ThisWorkbook.Worksheets("PRKS").Cells(i, 1).Value = "DTL" Then
            acc_name = ThisWorkbook.Worksheets("PRKS").Cells(i, 3).Value
            aal_alias = ThisWorkbook.Worksheets("PRKS").Cells(i, 5).Value
            fnd_name = ThisWorkbook.Worksheets("PRKS").Cells(i, 7).Value
            fal_alias = ThisWorkbook.Worksheets("PRKS").Cells(i, 9).Value
            txn_txn_date = Format(ThisWorkbook.Worksheets("PRKS").Cells(i, 12).Value, "yyyy/mm/dd")
            txt_code = ThisWorkbook.Worksheets("PRKS").Cells(i, 14).Value
            txn_units = ThisWorkbook.Worksheets("PRKS").Cells(i, 16).Value
            fpr_unit_price = ThisWorkbook.Worksheets("PRKS").Cells(i, 17).Value
            txn_amount = ThisWorkbook.Worksheets("PRKS").Cells(i, 20).Value
            fund_cur_alias = ThisWorkbook.Worksheets("PRKS").Cells(i, 27).Value
            account_cur_alias = ThisWorkbook.Worksheets("PRKS").Cells(i, 28).Value
            mc_txn_amount = ThisWorkbook.Worksheets("PRKS").Cells(i, 32).Value
            exchange_rate = ThisWorkbook.Worksheets("PRKS").Cells(i, 34).Value
            ' new fields from prks
            txt_memo = ThisWorkbook.Worksheets("PRKS").Cells(i, 35).Value
            acc_nsrd_sell_location = ThisWorkbook.Worksheets("PRKS").Cells(i, 37).Value
            mcx_txn_amount = ThisWorkbook.Worksheets("PRKS").Cells(i, 40).Value
            isin = ThisWorkbook.Worksheets("PRKS").Cells(i, 41).Value
        
            If fund_cur_alias = "UKS" Then
                fund_cur_alias = "GBP"
            End If
        
            With ThisWorkbook.Worksheets("Report")
                .Cells(int_row_count, 1) = txn_txn_date
                .Cells(int_row_count, 2) = acc_nsrd_sell_location
                .Cells(int_row_count, 3) = acc_name
                .Cells(int_row_count, 4) = aal_alias
                ' isin
                .Cells(int_row_count, 5) = isin
                .Cells(int_row_count, 6) = fnd_name
                .Cells(int_row_count, 7) = fal_alias
                If txt_code = "US" Then
                    int_sign = -1
                Else
                    int_sign = 1
                End If
                .Cells(int_row_count, 8) = int_sign * txn_units
                
                .Cells(int_row_count, 9) = fpr_unit_price * 1
                .Cells(int_row_count, 11) = fund_cur_alias
                
                ' account_cur_alias
                ' exchange_rate
                'If mc_txn_amount = 0 Then
                '    .Cells(int_row_count, 12) = int_sign * txn_amount * exchange_rate
                '    .Cells(int_row_count, 14) = 1 * mcx_txn_amount
                'Else
                '    .Cells(int_row_count, 12) = int_sign * mc_txn_amount
                '    .Cells(int_row_count, 14) = int_sign * mcx_txn_amount
                'End If
                .Cells(int_row_count, 12) = int_sign * mc_txn_amount
                .Cells(int_row_count, 14) = int_sign * mcx_txn_amount

                .Cells(int_row_count, 13) = int_sign * txn_amount
                
                ' euro
    
                .Cells(int_row_count, 15) = txn_txn_date
                .Cells(int_row_count, 16) = txt_memo
                int_row_count = int_row_count + 1
              End With
        
        End If
        i = i + 1
    Loop While ThisWorkbook.Worksheets("PRKS").Cells(i, 1).Value <> ""
End Sub

Je n'ai pas mis tous les modules mais uniquement celui qui sert à créer le reporting. Les autres ne sont pas essentiels pour comprendre le code.

Merci d'avance !!!

ucfoutu · Accepted Answer

Tu comprendrais cependant très très très vite en ouvrant ton aide VBA sur les mots :
1) Mid
2) Instrrev

Et tu comprendrais encore plus vite en passanty en mode debug et en découvrant ce que contient :
Application.VBE.ActiveVBProject.Filename
(tu découvrirais qu'il s'agit d'un chemin completr de fichier)
Il t-e serait alors facile de comprendre que ce que tu n'as pas encore compris est tout simplement une manière d'extraire de ce chemin complet : le seul nom (avec son extension) du fichier concerné

Fais donc des petites expériences, telle celle-ci
   toto = "D:\blabla\blibli\bloblo.txt"
  MsgBox Mid(toto, InStrRev(toto, "") + 1)

Ce sont souvent là des réflexes assez salutaires et instructifs 
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Bonjour, 1) un code mis ici sans mise en forme et sans indentation ne trouvera pas beaucoup de forumeurs prêts à l'analyser ! 2) je n'en ai donc lu que les toutes premières lignes. Et déjà : .AllowMultiSelect = False ' <<<<=== (1*) ===>> donc on ne pourra y choisir qu'un article If .Show = -1 Then '====>> qui vet dire en fait : si .show = True (donc qu'on n'a pas annulé) For Each vrtSelectedItem In .SelectedItems ' ===>> une boucle sur tous les articles ? Quels, tous ? voir point (1*) selectedfile = vrtSelectedItem Next vrtSelectedItem Else selectedfile = "" End If Alors : je travaille sur un code qui a été fait par quelqu'un d'autre avant moi S'il a ainsi lui-même tout codé au lance-pierre (et probablement par copier-coller de choses ramassées ici et là et ... apparemment sans v(raiment les comprendre lui non plus) ===>> tu ferais mille fois mieux de tout recoder ! ____________________ Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs. Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

bloutch · Answer

Ok merci de cette réponse !
Le truc c'est que j'ai bien peur que mon niveau de vba soit en dessous du sien... Je maitrîse bien les différents conceptes de boucle mais les .select, .allowmultiselect etc, je n'ai jamais vu donc je galère un peu...

C'est la même chose pour la définition de certaine variable, qu'est ce que filedialog ou MsoFileDialogType ?

Mais ce que je comprend le moin, c'est ça :

XLSWorkingFile = Mid(Application.VBE.ActiveVBProject.Filename, _ 
InStrRev(Application.VBE.ActiveVBProject.Filename, "") + 1) 

Est-ce que tu pourrais m'expliquer rapidement ce que ça veut dire ?

Merci d'avance

bloutch · Answer

Ok merci beaucoup. Je vais décrypter ce code au fur et à mesure grâce à l'aide de VBA. Ca me permettra d'acquérir les bons réflexes !

Problème de compréhension d'un code simple

4 réponses

Votre réponse

Discussions similaires