Problème de compréhension d'un code simple [Résolu]

Signaler
Messages postés
3
Date d'inscription
vendredi 23 septembre 2011
Statut
Membre
Dernière intervention
29 septembre 2011
-
Messages postés
3
Date d'inscription
vendredi 23 septembre 2011
Statut
Membre
Dernière intervention
29 septembre 2011
-
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 !!!

4 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
233
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
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
233
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
Messages postés
3
Date d'inscription
vendredi 23 septembre 2011
Statut
Membre
Dernière intervention
29 septembre 2011

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
Messages postés
3
Date d'inscription
vendredi 23 septembre 2011
Statut
Membre
Dernière intervention
29 septembre 2011

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 !