Optimisation de Code VBA

**RastaBomboclat** · 08/02/2016, 18h07

Bonsoir,

J’ai fait une petit appli Excel qui fonction un peu bien mais est lourde et le deviendra de plus en plus à chaque fois qu’on y insèrera des données.
J'ai donc quelque problèmes que j'aimerai resoudre.

Merci d'avance pour la collaboration de tous.

Ci-dessous mon code. Est-il possible de le rendre plus court, plus simple et moins lourd ? Parce que là je n'y ai mis que 3 Controles, mais j'en ai 22. Et si j'en avais plus de 50, ça donnerai quoi?

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
Option Explicit
Private F As Worksheet 'déclare la variable O et F (Onglet)
Private DL01 'déclare la variable DL01(Dernière Ligne)
 
Sub SubmitPayable()
Application.ScreenUpdating = False
'Traitement du transfert des données du frm_InvoiceEntries sur la feuille Excel
 
Dim PL As Variant
Dim NF1, NF2, NF3
Set F = Sheets("Sheet1") 'définit la Feuil F
DL01 = F.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL01 de la colonne 2 (=B) de l'onglet F
'
'
            DL01 = DL01 + 1 'redéfinit la dernière ligne DL01
            Set PL = F.Range("B8:B" & DL01) 'redéfinit la plage PL
            NF1 = frm_InvoiceEntries.cbox_Supplier.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 2).Value = NF1 'place le nom dans la cellule ligne DL01, colonne 2 de l'onglet F Sheet1
            '''
            DL01 = DL01
            Set PL = F.Range("C8:C" & DL01) 'redéfinit la plage PL
            NF2 = frm_InvoiceEntries.txt_InvoiceNum.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 3).Value = NF2 'place le nom dans la cellule ligne DL01, colonne 3 de l'onglet F Sheet1
            '''
            DL01 = DL01 
            Set PL = F.Range("D8:D" & DL01) 'redéfinit la plage PL
            NF3 = frm_InvoiceEntries.DTPicker1.Value 'frm_InvoiceEntries.TextBox2.Value 'définit l'objet dans lequel se trouve la donnée à transferer sur la feuille
            F.Cells(DL01, 4).Value = NF3 'place le nom dans la cellule ligne DL01, colonne 4 de l'onglet F Sheet1
 
End Sub

J’ai un formulaire avec un Textebox et une ListBox. En double cliquant sur une ligne de ma ListBox les données de cette ligne s’affichent sur une autre Userform, mais il y a un décalage. C’est une autre ligne qui s’affiche, et avec un décalage de -5 lignes. Peut-être que c’est la fatigue ou la pression, mais je ne vois pas où se trouve l’erreur dans mon code.
Pouvez-vous y jeter un coup d’œil et m’éclairer ? Voici le code:

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Option Explicit
 
Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
 
Private Sub UserForm_Initialize()
Set O = Sheets("Sheet1") 'définit l'onglet O
TC = O.Range("A7").CurrentRegion 'définit le tableau de cellules TC
Me.ListBox1.ColumnCount = UBound(TC, 2) + 1 'définit le nombre de colonnes de la ListBox1
Me.ListBox1.ColumnWidths = "0pt" 'masque la première colonne de la ListBox1
End Sub
 
Private Sub txt_CostCenter_Change() 'au changement dans la txt_CostCenter
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
 
Me.ListBox1.Clear 'vide la ListBox1
If Me.txt_CostCenter.Value = "" Then Exit Sub 'si la txt_CostCenter est vide (effacée), sort de la procédure
K = 1 'initialise la variable K
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC (en partant de la seconde)
    For J = 1 To UBound(TC, 2) 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
        'condition : si la valeur ligne I colonne J de TC contient le texte de la txt_CostCenter
        If UCase(TC(I, J)) Like "*" & UCase(Me.txt_CostCenter.Value) & "*" Then
            ReDim Preserve TL(1 To UBound(TC, 2) + 1, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonne plus une, K colonnes)
            TL(1, K) = I 'récupère dans la ligne 1 de TL le numéro de ligne I (cette donnée sera masquée après transposition)
            For L = 2 To UBound(TC, 2) + 1 'boucle 3 : sur les lignes 2 à nombre de colonnes de TC plus une, de TL
                TL(L, K) = TC(I, L - 1) 'récupere dans la ligne de TL, la valeur de la colonne de TC (=> transposition)
            Next L 'prochaine ligne de la boucle 3
            K = K + 1 'incrément K (=> ajoute une colonne à TL)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'procjaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
If K = 1 Then Exit Sub 'si K est égale à un (=> aucune occurrence vérifiant la condition), sort de la procédure
If K = 2 Then ReDim Preserve TL(1 To UBound(TL, 1), 1 To 2) 'si K=2 (=> une seule occurrence), redimensionne TL pour permettre la transposition
Me.ListBox1.List = Application.Transpose(TL) 'alimente la ListBox1 avec le trableau TL transposé (le numéro de ligne en colonne 1 est masqué)
End Sub
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'au double-Click dans la ListBox1
Dim CTRL As Control 'déclare la variable TC (Tableau de Cellules)
On Error GoTo ErrorHandler
If Me.txt_CostCenter.Value = "" Then
    MsgBox Application.UserName & vbNewLine & vbNewLine & "Deves prehencher o campo de procura: Search", vbExclamation, "Campo de procura vazio"
    Me.txt_CostCenter.SetFocus
    Exit Sub
Else
LI = CInt(Me.ListBox1.Column(0, Me.ListBox1.ListIndex)) 'récupère le numéro de ligne LI dans la colonne masquée de la ListBox1
With frm_UpdateInvoice 'prend en compte l'frm_UpdateInvoice
    .Caption = "Modificar" 'change le titre
    For Each CTRL In .Controls 'boucle sur tous les contrôles
        'si la propriété [Tag] du contrôle n'est pas vide, récupère dans le contrôle la valeur de la cellule, ligne : LI, colonne : propriété [Tag] du contrôle convertie en byte, de l'onglet O
        If CTRL.Tag <> "" Then CTRL.Value = O.Cells(LI, CByte(CTRL.Tag)).Value
    Next CTRL 'prochain contrôle de la boucle
    With .cbox_Supplier 'prend en compte la cbox_Supplier(Selection des fournisseur)
        'sélectionne le texte
        .SetFocus 'place le curseur
        .SelStart = 0 'début de la sélection
        .SelLength = .TextLength 'longueur de la sélection
    End With 'fin de la prise en compte de la cbox_Supplier
    Unload Me 'vide et ferme l'UserForm2
    .Show 'affiche l'frm_UpdateInvoice
End With 'fin de la prise en compte de le frm_UpdateInvoice
End If
 
ErrorHandler:
Resume Next
End Sub

Et dans le module:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Option Explicit
Public LI As Integer

**patricktoulon** · 08/02/2016, 19h35

Bonsoir
pour le premier code si tu te sert pas de dl01 dans une autre sub tu remplace le premier code en entier par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With Sheets("sheets1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
.Value = frm_InvoiceEntries.cbox_Supplier.Value
.Offset(0, 1) = frm_InvoiceEntries.txt_InvoiceNum.Value
.offset(0 , 2) = frm_InvoiceEntries.DTPicker1.Value
End With

voila pour commencer

**joe.levrai** · 08/02/2016, 19h40

Bonjour,

si la valeur de tes contrôles s'écrit à la suite dans une feuille excel, tu peux faire comme ça :

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
Sub SubmitPayable()
Dim TabControl(), DerLig As Long
    ' on met la valeur des contrôles dans un tableau
    ' dans l'ordre d'écriture de la feuille
    With frm_InvoiceEntries
        TabControl = Array(.cbox_Supplier.Value, .txt_InvoiceNum.Value, .DTPicker1.Value)
    End With
 
    With Sheets("Sheet1")
        DerLig = .Cells(.Rows.Count, 2).End(xlUp)(2)
        ' boucle sur les valeurs des contrôles
        For i = LBound(TabControl) To UBound(TabControl)
            ' écriture dans les cellules
            .Cells(DerLig, i + 2).Value = TabControl(i)
        Next i
    End With
End Sub

Quand on commence àa voir beaucoup de contrôles, ça peut devenir fastidieux d'écrire tous les contrôles dans le tableau TabControl
Dans ce cas, on peut utiliser le Tag des contrôles (c'est une propriété de chaque contrôle où on peut écrire une valeur).

1) dans tous les contrôles où les valeurs doivent être écrites dans la feuille : indiquer le numéro de la colonne d'écriture dans le tag
2) laisser le Tag vide pour les contrôles qui ne doivent pas être écrits

Utiliser ce modèle de procédure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub SubmitPayable()
Dim Ctrl, DerLig As Long
    With Sheets("Sheet1")
        DerLig = .Cells(.Rows.Count, 2).End(xlUp)(2)
 
        For Each Ctrl In frm_InvoiceEntries.Controls
            If Ctrl.Tag <> "" Then .Cells(DerLig, Ctrl.Tag).Value = Ctrl.Value
        Next Ctrl
    End With
End Sub

si tu as certains contrôles où ce n'est pas le .Value qui doit être récupéré (ListBox par exemple) il faut ajouter une condition avant l'écriture pour détecter le type de contrôle (et agir en conséquence).

pour ta seconde question (décalage de 5), je regarde et si je vois un truc je rajouterai un second message

**RastaBomboclat** · 08/02/2016, 20h02

Bonsoir,

Je voudrais ajouter une 3ème préoccupation.
J’ai un tableau avec plusieurs colonnes (28), et j’aimerais présenter les données dudit tableau avec un filtre basé la 27ème et la 22ème colonne, sur un formulaire(Filtrage multicritère). Je souhaiterai avoir le résultat sur un formulaire pour que l’utilisateur n’ait pas accès à la feuille Excel mais juste au formulaire pour voir les factures à payer.
Si quelqu’un a une idée avec un code, merci d’avance.

PS: je fais se poste ici de peur de recevoir un autre avertissement

des administrateur et finir par être exclus de ce forum qui m'aide tant. Sinon les Administrateur peuvent le deplacer pour le mettre dans un nouveau post à part

**RastaBomboclat** · 08/02/2016, 21h11

Hum,

J'a reçu des messages pendant que j'en postais aussi.

Patricktoulon et Joe.levrai.

Patricktoulon ton code function mais il me donne encore plusieur ligne a ecrire. Mais je le garde dans mes notes (aide mémoire), c’est une nouvelle procedure que je viens d’appredre et qui comme toujours me servira.

Joe.levrai, ton code 2ème code est celui qui me convidrai (une boucle sur tous les contrôle avec un TAG), s’il ne générait pas une erreur en ligne 7
En effet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Cells(DerLig, Ctrl.Tag).Value = Ctrl.Value

est surligné et me donne "DerLig=0"
je ne sais pas si j'ai omis quelque chose.

**joe.levrai** · 08/02/2016, 21h49

Arf, j'ai mangé un mot

rajoute la propriété .Row

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DerLig = .Cells(.Rows.Count, 2).End(xlUp)(2).Row

**RastaBomboclat** · 10/02/2016, 15h56

Bonjour Joe,
Ça ne passe toujours.
Entre temps j’ai pu résoudre, hier, le deuxième problème qui était qui me donné un décalage de -5 lignes. Par essai et tentative pas à pas, j’ai fini par remplacer le:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TC = O.Range("A7").CurrentRegion 'définit le tableau de cellules TC

Par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TC = O.Range("A5").CurrentRegion 'définit le tableau de cellules TC

La ligne 5 n'est pas le debut de mon tableau mais, du moment que ça marche bien et jusque là sans soucis, pour moi C'est Bon

En outre, j’attends encore des idées sur le troisième problème que j’avais présenté. J’ai pu avoir une solution Excel directement sur la feuille et non pas sur un formulaire. Voilà pourquoi je continue d’attendre si une solution formulaire est possible et si quelqu’un pourrait me fournir le code. Sinon, je serai bien obligé de me tourner vers la feuille Excel que je voulais impérativement éviter aux utilisateurs.

**RastaBomboclat** · 11/02/2016, 19h52

Bonsoir,

Je viens de trouver un code super intéressant de patricktoulon ici qui permet de faire ce que je voulais. Ça marche déjà et je n’ai plus qu’à l’adapter a mes besoin.

Dans le formulaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub UserForm_Activate()
With Me.WebBrowser1
        .Navigate "about:blank"
        .Silent = True
        .Document.Write "<html><head></head><body><div id=""editeur"" contenteditable=""true"" ></div></body></html>"
        'Do: DoEvents: Loop Until .ReadyState = 4
.Refresh
    .Document.getelementbyid("editeur").Focus
        SendKeys "{enter}"
        End With
SendKeys "^v"
End Sub

Dans le module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub copyplagehtml()
Sheets(1).Range("b4:g14").Copy
UserForm1.Show 0
End Sub

Merci pour vos contributions.
Merci Patrick

Optimisation de Code VBA

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager