Macro Excel Vba

**gFZT82** · 18/07/2012, 13h05

Les 2 procédures étant indépendantes, le plus simple, c’est que tu lances une procédure après l’autre.
Tu renommes la première procédure : Private Sub CommentSupport()
Tu renommes la deuxième procédure : Private Sub CommentClosed()
Et tu codes

Code :

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

1
2
3
4
Private Sub CommandButton3_Click()
    CommentSupport
    CommentClosed
End Sub

Voici, un peu plus concrètement ce que ça peut donner

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Private Sub CommandButton3_Click() 'Bouton Commentaires
Dim Fichier As String, Chemin As String
Dim WbCible As Workbook, WbSource As Workbook
Dim WsCible As Worksheet, WsSource As Worksheet
    'Nouveau fichier issu de la mise à jour
    Set WbCible = Workbooks("Restitutions.xls")
    'Ancien fichier où se trouvent les commentaires
    Fichier = TextBox1.Text
    Chemin = ThisWorkbook.Path
    'Ouverture Ancien fichier
    Set WbSource = Workbooks.Open(Chemin & "\" & Fichier)
    'Mise à jour des commentaires de la feuille "Support"
    Set WsCible = WbCible.Worksheets("Support")
    Set WsSource = WbSource.Worksheets("Support")
    CommentSupport WsCible, WsSource
    'Mise à jour des commentaires de la feuille "Closed"
    Set WsCible = WbCible.Worksheets("Closed")
    Set WsSource = WbSource.Worksheets("Closed")
    CommentClosed WsCible, WsSource
    'Effacement
    Set WsSource = Nothing
    Set WbSource = Nothing
    Set WsCible = Nothing
    Set WbCible = Nothing
End Sub
Private Sub CommentSupport(WsCible, WsSource)
Dim i As Integer, j As Integer, NbLigne As Integer, NumCl As Integer
Dim Trouver As Boolean
    Me.Hide
    Application.ScreenUpdating = False
    'Nombre de lignes dans l'ancien fichier
    NbLigne = WsSource.Cells(1, 1).CurrentRegion.Rows.Count
    'On balaye toutes les lignes de l'ancien fichier
    For i = 2 To NbLigne
        'On copie le commentaire
        WsSource.Cells(i, 16).Copy
        'On relève l'identifiant de la ligne où doit se trouver le commentaire
        NumCl = WsSource.Cells(i, 1)
        Trouver = True
        j = 2
        'Si le commentaire existe
        If IsEmpty(WsSource.Cells(i, 16)) = False Then
            'On balaye toutes les lignes du nouveau fichier afin de trouver le même identifiant
            While Trouver And j < NbLigne + 1
                'Si le même identifiant est trouvé, on copie le commentaire
                If WsCible.Cells(j, 1).Value = NumCl Then
                    WsCible.Paste Destination:=WsCible.Cells(j, 16)
                    Trouver = False
                Else
                    j = j + 1
                End If
            Wend
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Private Sub CommentClosed(WsCible, WsSource)
Dim i As Integer, j As Integer, NbLigne As Integer, NumC As Integer
Dim Trouver As Boolean
    Application.ScreenUpdating = False
    'Nombre de lignes dans l'ancien fichier
    NbLigne = WsSource.Cells(1, 1).CurrentRegion.Rows.Count
    'On balaye les 3 colonnes de commentaires de l'ancien fichier
    For k = 18 To 20
        'On balaye toutes les lignes de l'ancien fichier
        For i = 2 To NbLigne
            'On copie les commentaires
            WsSource.Cells(i, k).Copy
            'On relève l'identifiant de la ligne où doit se trouver les commentaires
            NumC = WsSource.Cells(i, 1)
            Trouver = True
            j = 2
            'Si le commentaire existe
            Debug.Print WsSource.Cells(i, k)
            If IsEmpty(WsSource.Cells(i, k)) = False Then
                'On balaye toutes les lignes du nouveau fichier afin de trouver le même identifiant
                While Trouver And j < NbLigne + 1
                    'Si le même identifiant est trouvé, on copie le commentaire
                    If WsCible.Cells(j, 1).Value = NumC Then
                        WsCible.Paste Destination:=WsCible.Cells(j, k)
                        Trouver = False
                    Else
                        j = j + 1
                    End If
                Wend
            End If
        Next i
    Next k
    Unload Me
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Cordialement.

**Vanene** · 18/07/2012, 18h09

Malgré de nombreux tests, ça ne veut pas fonctionner. C'est sans doute une explication simple mais je ne vois pas d'où vient l'erreur. Je vous envoie les documents (la macro, l'ancien fichier avec les commentaires, le nouveau fichier) afin que vous puissiez également tester de vos coté et dire ce qui ne va pas...

Merci bcp!!!

Cdlt
Vanessa

**gFZT82** · 18/07/2012, 18h27

Je pense que tu as dû zapper mon dernier message avec le code de mise en application.
Voici le classeur macro avec la mise à jour.

Cordialement.

**Vanene** · 19/07/2012, 13h10

Bonjour,

Ah oui effectivement j'ai zappé le message précédent, désolée...
Ca marche très bien. Merci encore.
Par contre mon maitre de stage m'a demandé encore de faire la même chose mais pour l'onglet "Evolution" cette fois-ci. Je suppose que le code reste le même. J'ai donc essayé de l'implémenter pour répondre aux besoin de mon maitre de stage mais ça ne marche pas. Décidément, j'ai pas mal de difficulté avec ces macros...
Je vous envoie la macro afin que vous puissiez voir ce que j'ai ajouté pour l'onglet "Evolution".

Cdlt
Vanessa

**gFZT82** · 19/07/2012, 16h46

Ton maitre de stage serait-il de la famille Bahlsen ?
Voila de quoi satisfaire monsieur Plus.
Le problème venait du Unload Me qui n’était pas placé correctement.

Cordialement.

**Vanene** · 19/07/2012, 17h48

ahah oui il me demande pas mal de choses avant mon départ.
La raison était juste le Unload me, fallait le savoir...

Tu as aussi ajouter le me.hide dans le code, ça correspond à quoi en fait?

Merci bcp pour ton aide en tout cas!!

Cordialement.
Vanessa

**gFZT82** · 19/07/2012, 18h53

Me.hide permet de masquer l’userform sans le décharger alors que Unload le supprime de la mémoire.
Tant que tu as besoin des éléments associés à l’userform mais que tu ne veux pas son affichage à l’écran, tu utilises Hide.
Dès que tu n’a plus besoin de ces données, tu utilises Unload pour libérer la mémoire.

Cordialement.

Macro Excel Vba

Macros et VBA Excel

Discussions similaires

Partager

Partager