Discussion :

[Jean-Philippe44]

Bonjour,

je cherche a faire une fonction numéro de paragraphe qui sera insérée dans une cellule: Par()

en utilisant Application.Caller est il possible d'affecter directement l index ?

Par exemple

le 1er Par() rencontré dans le classeur prend la valeur 1

le 2eme Par() rencontré dans le classeur prend la valeur 2

Application.Caller.Index ne fonctionne pas

merci

Mon rêve c'est ca.....:

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
 
Function Par() As Variant
 
    Dim Fonction As Application.Caller
 
    For Each Fonction In ThisWorkbook.Fonction
 
        If Fonction.Name = Par Then
 
            Par() = Fonction.Index
 
        End If
 
    Next Fonction
 
End Function

bien sur ca ne marche carrement pas.............

[Jean-Philippe44]

je n'arrive pas a attribuer le numéro courant, toutes les fonctions
par dans les cellules de la feuille excel prennent la dernière valeur

j'en suis la:

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
Function par() As Integer
 
    par = 0
 
    i = 1
 
    For j = 2 To ThisWorkbook.Sheets.Count
 
        If Sheets(j).Name = "FIN" Then
 
            Exit For
 
        End If
 
        If "(" & ThisWorkbook.Worksheets(j).PageSetup.PrintArea & ")" <> "()" Then
 
            For Each cell In ThisWorkbook.Worksheets(j).Range("(" & ThisWorkbook.Worksheets(j).PageSetup.PrintArea & ")")
 
                If cell.Formula Like "=par()" Then
 
                    par = i
 
                    i = i + 1
 
                End If
 
            Next cell
 
        End If
 
    Next j
 
 
End Function

[Jean-Philippe44]

Bonjour,
ca ca marche

si quelqu'un veut optimiser, ce sera avec un grand merci

je passe au sous paragraphes S_Par() et j'ai un problème d' "ordre", si quelqu'un le voit....

ca peut être sympa de rentrer dans le jeu....

j ai la numérotation des pages et le nombre de pages que je file demain

pour les paragraphes:

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
 
Function Par() As String
 
    Par = "- "
 
    i = 1
 
    Sortie = False
 
    For j = 2 To ThisWorkbook.Sheets.Count
 
        If Sheets(j).Name = "FIN" Then
 
            Exit For
 
        End If
 
        If ThisWorkbook.Worksheets(j).PageSetup.PrintArea <> "" Then
 
            For Each cell In ThisWorkbook.Worksheets(j).Range(ThisWorkbook.Worksheets(j).PageSetup.PrintArea)
 
                If cell.Address = Application.Caller.Address And cell.Parent.Name = Application.Caller.Worksheet.Name Then
 
                    Par = i & ". "
                    Sortie = True
                    Exit For
 
                End If
 
                If cell.Formula Like "=par(*" Then
 
                    i = i + 1
 
                End If
 
            Next cell
 
        End If
 
        If Sortie Then Exit For
 
    Next j
 
End Function

les sous paragraphes (ne fonctionne pas completement):

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
 
Function S_Par() As String
 
    S_Par = "- "
 
    k = 1
 
    Sortie = False
 
    Ancien = 1
 
    For j = 2 To ThisWorkbook.Sheets.Count
 
        If Sheets(j).Name = "FIN" Then
 
            Exit For
 
        End If
 
        If ThisWorkbook.Worksheets(j).PageSetup.PrintArea <> "" Then
 
            For Each cell In ThisWorkbook.Worksheets(j).Range(ThisWorkbook.Worksheets(j).PageSetup.PrintArea)
 
                If cell.Address = Application.Caller.Address And cell.Parent.Name = Application.Caller.Worksheet.Name Then
 
                    'MsgBox Par
 
                    'MsgBox "Nouveau :" & CInt(Replace(Par, ".", "")) - 1 & " Ancien: " & Ancien
 
                    MsgBox Par
 
                    If CInt(Replace(Par, ".", "")) - 1 <> Ancien Then
 
                        k = 1
 
                    End If
 
                    S_Par = CInt(Replace(Par, ".", "")) - 1 & ". " & k & ". "
                    Ancien = CInt(Replace(Par, ".", "")) - 1
 
                    Sortie = True
                    Exit For
 
                End If
 
 
 
                If cell.Formula Like "=S_Par(*" Then
 
                    k = k + 1
 
                End If
 
            Next cell
 
        End If
 
        If Sortie Then Exit For
 
    Next j
 
End Function