Discussion :

[Tournament]

Bonjour,

je souhaiterais modifier la fin de ce code
Merci d avance pour votre aide

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
Sub Hmc()
    Const AG = "MDL"
 
    With Feuil2.Cells(1).CurrentRegion
        For R& = 1 To .Rows.Count
            If .Cells(R, 7).Text = AG And .Cells(R, 4).Value < Date Then T$ = T$ & vbLf & .Cells(R, 6).Text & vbTab & vbTab & .Cells(R, 5).Text & vbTab & vbTab & .Cells(R, 1).Text & vbTab
        Next
    End With
 
    If T > "" Then MsgBox "date de retour dépassée !" & Chr(10) & Chr(10) & "NO DOC" & vbTab & vbTab & "TYPE DE DOC" & vbTab & "IMMAT" & T, vbExclamation, "   EN DATE DEPASSEE " & AG
 
'si OK quitter la procédure 
'si il n y a pas de doc a date dépassé msgbox pour dire "pas de date dépassee"
'alors Call macro(xxxx)
 
End Sub

[tamtam64]

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
Sub Hmc()
    Const AG = "MDL"
 
    With Feuil2.Cells(1).CurrentRegion
        For R& = 1 To .Rows.Count
            If .Cells(R, 7).Text = AG And .Cells(R, 4).Value < Date Then T$ = T$ & vbLf & .Cells(R, 6).Text & vbTab & vbTab & .Cells(R, 5).Text & vbTab & vbTab & .Cells(R, 1).Text & vbTab
        Next
    End With
 
    If T > "" Then MsgBox "date de retour dépassée !" & Chr(10) & Chr(10) & "NO DOC" & vbTab & vbTab & "TYPE DE DOC" & vbTab & "IMMAT" & T, vbExclamation, "   EN DATE DEPASSEE " & AG
 
'si il n y a pas de doc a date dépassé msgbox pour dire "pas de date dépassee"
if isempty(T) then msgbox("Pas de date depassée")
call Nom de macro()
 
End Sub

je comprend pas ton Ok qu'est ce que tu veux dire ?

[Tournament]

Salut

c était le OK de la msgbox qui donne les doc en date dépassé
si l'opérateur clique sur le bouton ok après avoir pris connaissance des données
la procédure s'arrète
si il n y a pas de date dépassée alors msgbox " pas de date dépassée"
call macro( xxx)

Avec ta modification, même si la msgbox indique des doc à date dépassée la procédure continue et actionne la 2ème macro
merci pour ton aide

allez LENS

[tamtam64]

Salut

c était le OK de la msgbox qui donne les doc en date dépassé

Code :

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

rep = msgbox("mssage",OKCancel)

si l'opérateur clique sur le bouton ok après avoir pris connaissance des données
la procédure s'arrète

Code :

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

if rep = 1 then end

si il n y a pas de date dépassée alors msgbox " pas de date dépassée"
call macro( xxx)

Code :

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

if isempty(T) then call xxx

Merci allez lens ou :p ah ah

[Tournament]

Ah là là !!
je suis hors jeu ...

Ca ne marche pas.
Alors je reprends depuis le début
si la macro trouve des doc avec des dates dépassées une 1ere msgbox s'ouvre pour indiquer les docs en question.
Quand l opérateur cliquera sur le OK de cette msgbox plus rien ne se passe il doit aller modifier les documents.

Qd il aura terminé, il n y aura donc plus de docs à date dépassée , ainsi une msgbox lui indiquera "pas de date dépassée"
le bouton OK de cette msgbox déclenchera une nouvelle macro.

merci encore

help !!!

[tamtam64]

en fait j'ai du mal avec ce code , je trouve qu'il n'est pas tres facile a comprendre et est codé un peu bizarrement, je pense pas que ce soit une bonne idee de coder comme ca quand on débute... enfin il me semble

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
Option Explicit
Option Base 1
 
Sub test()
    Dim valeur As Integer
    Dim xlsheet As Worksheet, xlsheet2 As Worksheet
    Dim MyRange As Range, AllRange As Range
    Dim MyDico As New dictionary
    Dim MyObject As Contenu
    Dim Clef As String
    Dim Key As Variant
    Dim MyTab, MyTab2()
    Dim i As Long
Set xlsheet = ThisWorkbook.Worksheets("Feuil3")
Set xlsheet2 = ThisWorkbook.Worksheets("Feuil4")
With xlsheet
    Set AllRange = .Range(.Range("A2"), .Range("A2").End(xlDown))
    For Each MyRange In AllRange.Cells
        Clef = MyRange.Value & "//" & MyRange.Offset(, 1).Value & "//" & MyRange.Offset(, 2).Value & "//" & MyRange.Offset(, 3).Value
        If Not MyDico.Exists(Clef) Then
            Set MyObject = New Contenu
            MyTab = Split(Clef, "//")
            MyObject.Agence = MyTab(3)
            MyObject.DateS = MyTab(1)
            MyObject.Matricule = MyTab(0)
            MyObject.TypeD = MyTab(2)
            MyDico.Add Clef, MyObject
        End If
    Next MyRange
End With
i = 1
valeur = InputBox("Rentre le numero de l'agence")
'supprimer la clef en trop
For Each Key In MyDico.Keys
    If MyDico(Key).Agence = valeur And MyDico(Key).DateS < Date Then
        ReDim Preserve MyTab2(2, i)
        MyTab2(1, i) = MyDico(Key).TypeD
        MyTab2(2, i) = MyDico(Key).Matricule
        i = i + 1
    End If
Next Key
    If LBound(MyTab2) < 1 Then
        MsgBox ("Pas de Pb")
    Else
        For i = 1 To UBound(MyTab2, 2)
            MsgBox ("le type" & MyTab2(1, i) & "a un pb" & "avec le matricule" & MyTab2(2, i))
        Next i
    End If
End Sub

tu rajoute une classe Contenu dans un module de classe

Code :

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

1
2
3
4
5
6
Option Explicit
 
Public Matricule As Long
Public DateS As Date
Public TypeD As String
Public Agence As Integer

Pour ce code tu dois rajouter la reference microsoft runtime. pour pouvoir utiliser les dictionnaires

et ca fait ce que tu veux et c'est vraiment trés modulable mais effectivement un peu long , mais declarer les variables avec & ou des $ c'est pas ultra lisible je trouve donc un peu inutile

[Theze]

Bonjour,

Teste ceci :

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
 
Sub Hmc()
 
    Const AG = "MDL"
 
    With Feuil2.Cells(1).CurrentRegion
 
        For R& = 1 To .Rows.Count
 
            If .Cells(R, 7).Text = AG And .Cells(R, 4).Value < Date Then
 
                T$ = T$ & vbLf & .Cells(R, 6).Text & vbTab & vbTab & .Cells(R, 5).Text & vbTab & vbTab & .Cells(R, 1).Text & vbTab
 
            End If
 
        Next
 
    End With
 
    If T <> "" Then
 
        MsgBox "date de retour dépassée !" & Chr(10) & Chr(10) & "NO DOC" & vbTab & vbTab & "TYPE DE DOC" & vbTab & "IMMAT" & T, vbExclamation, "   EN DATE DEPASSEE " & AG
 
    Else
 
        MsgBox "pas de date dépassée !"
        macro2
 
    End If
 
End Sub

Hervé.