conditions a rajouter dans un code

Version imprimable

Bonjour,

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

Code:

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

Code:

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 ?

20/06/2015, 16h50
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
20/06/2015, 16h55
tamtam64

Salut

Citation:

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

Code:

rep = msgbox("mssage",OKCancel)

Citation:

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

Code:

if rep = 1 then end

Citation:

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

Code:

if isempty(T) then call xxx

Merci allez lens ou :p ah ah
20/06/2015, 17h15
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 !!!

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:

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:

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

Bonjour,

Teste ceci :

Code:

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é.

21/06/2015, 08h27
Tournament

Bonjour à tous les deux

J ai testé la solution de Hervé et çà fonctionne !! génial !

ceci dit je vais aussi travailler sur la proposition de TamTam pour comprendre et cela me fera aussi un exercice

merci encore à vous deux !!

PS : hier j ' ai écrit un "help" qui m'a valut un carton jaune !!! que j ai trouvé normal et mérité ...
désolé encore mais ne connaissant pas encore toutes les règles du forum j ai fais cette erreur ; MEA CULPEA !!!

et Bonne Fête à tous les Papas ! :)

Bonjour tamtam64,

Citation:

declarer les variables avec & ou des $ c'est pas ultra lisible je trouve donc un peu inutile

C'est un héritage du basic où l'on déclarait les variables ainsi et ce n'est donc pas lisible pour ceux qui ne connaissent pas cette façon de déclarer une variable. Dim Nom$ ou Dim Nom as String, c'est du pareil au même et finalement on détecte tout de suite qu'un variable suivie de $ est une chaîne de caractères comme ceux qui adopte la notation hongroise (convention de nommage) et qui utiliseront le préfixe str (ex : strNom).
Une fois déclarée la variable peut-être accompagnée du signe ou pas. Exemple : MsgBox Nom$ ou MsgBox Nom
Petit exemple
Code:

1 2 3 4 5 6 7 Dim A$, B%, c&, d!, e#, f@ Debug.Print TypeName(A) ' String Debug.Print TypeName(B) ' Integer Debug.Print TypeName(c) ' Long Debug.Print TypeName(d) ' Single Debug.Print TypeName(e) ' Double Debug.Print TypeName(f) ' Currency

21/06/2015, 13h55
tamtam64

Merci je connaissais le principe il existe la meme chose en Python, mais je trouve ca un peu illisible pour ceux qui doivent reprendre le code, car peu utilisé, c'est la meme chose en python. En realité moi j'utilise MyRange , MyDico.. qui est celon moi plus facile surtout ^pour quelqu'un qui ne maitrise pas encore vraiment vba. Ceci dit merci pour les infos car certains je ne les connaissais pas, ca peut tjs me servire pour comprendre des codes comme ce dernier. ;)