Discussion :

[famdsm]

bonjour
j'ai une base portant des clients, les factures et je cherche s'il est possible de realiser à chaque que je clique sur la feuille creance il me parait les situation des client qui n'ont pas regler leur facture.
Merci

[Thautheme]

Bonsoir Famdsm, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

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
Private Sub Worksheet_Activate()
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim C As Worksheet 'déclare la variable C (Onglet Creances)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément de ligne)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Dim J As Byte 'déclare la variable J (incrément de ligne)
 
Set B = Sheets("base") 'définit l'onglet B
Set C = Me 'définit l'onglet C
'si A2 de C n'est pas vide efface les anciennes données
If C.Range("A2").Value <> "" Then C.Range(C.Cells(2, 1), C.Cells(Application.Rows.Count, Application.Columns.Count)).ClearContents
TC = B.Range("A1").CurrentRegion 'définit le tableau de cellule TC
J = 1 'initialise J
For I = 3 To UBound(TC, 1) 'boucle sur toutes les lignes I du tableau de cellules TC (en partant de la troisième)
    If TC(I, 14) > 0 Then 'condition : si la cellule ligne I colonne 14 (=> colonne N) est supérieure à zéro
        ReDim Preserve TL(1 To 4, 1 To J) 'dedimentsionne le tabelau TL (4 lignes, J colonnes)
        TL(1, J) = TC(I, 3) 'récupère dans la ligne 1 colonne J de TL la valeur ligne I colonne 3 de TC (Client)
        TL(2, J) = TC(I, 1) 'récupère dans la ligne 2 colonne J de TL la valeur ligne I colonne 1 de TC (Numéro)
        TL(3, J) = TC(I, 2) 'récupère dans la ligne 3 colonne J de TL la valeur ligne I colonne 2 de TC (Date)
        TL(4, J) = TC(I, 14) 'récupère dans la ligne 4 colonne J de TL la valeur ligne I colonne 14 de TC (Reste)
        J = J + 1 'incrément J
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If J = 1 Then MsgBox "Aucune Créance !": Exit Sub 'si j est égal à un, messsage, sort de la procédure
'renvoie dans la cellule A2 redimensionnée de l'onglet C le tableau TL transposé
C.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub