Function as boolean

[cibleo]

Bonsoir le forum,

J'appelle cette function :

Function Gardes(jour As Date) As Boolean
Dim LeChauffeur As String
 For Each c In Sheets("PersonneldeGardes").Range("A3:A17")
  If c = jour Then
    Gardes = True
    LeChauffeur = Sheets("PersonneldeGardes").Cells(0, 1).Offset
    Exit Function
  End If
 Next c
End Function

Dans ce code générant 53 feuilles hebdomadaires :

Sub FeuillesSemaines1()
Dim deb As Long, fin As Long, i As Long, n As Byte, Tablo(1 To 53, 1 To 2), Sem As Byte, Nom As String, Nom1 As String
Dim tablo1(1 To 53, 1 To 7) As Date, x As Integer, y As Byte, k As Byte, j As Byte, Lig As Byte
If Sheets.Count > 2 Then Exit Sub
deb = DateSerial(2010, 12, 27) 'du Lundi 27 décembre 2010
fin = DateSerial(2012, 1, 1) 'au Dimanche 01 janvier 2012 soit 53 semaines
For y = 1 To 53
For k = 1 To 7
'tablo1(y, k) = Format(Deb + x, "ddd dd mmm yy")
tablo1(y, k) = deb + x
x = x + 1
Next k
Next y
For i = deb To fin
If i = deb Or Weekday(i) = 2 Then n = n + 1: Tablo(n, 1) = Format(i, "dd mmm yy")
If i = Date Then Sem = n
If i = fin Or Weekday(i) = 1 Then Tablo(n, 2) = Format(i, "dd mmm yy")
Next
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To n
Nom = "Semaine " & Tablo(i, 1) & " - " & Tablo(i, 2)
Nom1 = "Semaine du " & Format(Tablo(i, 1), "dddd dd mmmm yyyy") & " au " & Format(Tablo(i, 2), "dddd dd mmmm yyyy")
Nom = Sheets(Nom).Name
If Err Then
Err = 0
Sheets("Modele").Copy after:=Sheets(Sheets.Count)
' Sheets(Sheets.Count).Shapes("CommandButton1").Select 'supprime le bouton dela feuille créée
' Selection.Delete
' With ActiveWorkbook.VBProject.VBComponents(Sheets(Sheets.Count).CodeName).CodeModule 'Supprime la macro even. de la feuille créée
' .DeleteLines 1, .CountOfLines
' End With
Sheets(Sheets.Count).Name = Nom
Sheets(Sheets.Count).[A2] = Nom1
j = 1
For Lig = 4 To 10
Sheets(Sheets.Count).Range("A" & Lig) = tablo1(i, j)
If Gardes(tablo1(i, j)) = True Then
Sheets(Sheets.Count).[A12] = "Chauffeur de gardes le " & Format(tablo1(i, j), "dddd dd mmmm yyyy") & LeChauffeur
End If
j = j + 1
Next Lig
End If
Next
Sheets("Semaine " & Tablo(Sem, 1) & " - " & Tablo(Sem, 2)).Select 'semaine en cours
End Sub

.../...For Lig = 4 To 10
      Sheets(Sheets.Count).Range("A" & Lig) = tablo1(i, j)
      If Gardes(tablo1(i, j)) = True Then
      Sheets(Sheets.Count).[A12] = "Chauffeur de gardes le " & Format(tablo1(i, j), "dddd dd mmmm yyyy") & LeChauffeur
      End If
      j = j + 1
    Next Lig
.../...

J'aimerais placer en A12 de chaque feuille générée la mention suivante : Chauffeur de gardes le dimanche XX XXXXX 2011 + Le prénom du chauffeur

Je n'arrive pas à récupérer le nom du chauffeur figurant en colonne B feuille ("PersonneldeGardes").

Pour comprendre, cliquez sur le bouton et voyez en A12 des feuilles générées il manque le prénom du chauffeur.

Ps : j'ai complètement fouaré la rédaction de mon post 🙁

Cibleo

 

[Hippolite]

Re : Function as boolean

Bonsoir,
Tu déclares la variable LeChauffeur à l'intérieur de la fonction, elle est donc vidée quand tu quittes la fonction.
Pour qu'elle soit transmise, soit tu utilises des arguments de la fonction, soit tu la déclares d'une façon commune :
- soit avec Public... à la place de Dim...
- soit en déplaçant Dim... en tête de feuile avant les programmes et fonctions de la feuille qui de ce fait y auront accès.
Je te recommande fortement d'utiliser Option explicit en tête de page, ça évite bien des ennuis de faute d'écriture dans le nom des variables.
A+

 

[cibleo]

Re : Function as boolean

Bonsoir le forum,
Bonsoir Hippolite

Voilà, c'est mieux comme ceci.
La fonction :

Function RechercheDate(LaPlage As Range, LaDate As Date) As String
Dim c As Range
Set c = LaPlage.Find(LaDate)
If Not c Is Nothing Then
RechercheDate = c.Offset(0, 1).Value
Set c = Nothing
End If
End Function

Et l'appel de la fonction dans le bloc For Next :

Dim LeChauffeur As String, Plage As Range

.../...
For Lig = 4 To 10
Sheets(Sheets.Count).Range("A" & Lig) = tablo1(i, j)
 
Set Plage = Sheets("PersonneldeGardes").Range("A3:A" & Sheets("PersonneldeGardes").Range("A65536").End(xlUp).Row)
LeChauffeur = RechercheDate(Plage, tablo1(i, j))
If LeChauffeur <> "" Then
Sheets(Sheets.Count).[A12] = "Chauffeur de gardes le " & Format(tablo1(i, j), "dddd dd mmmm yyyy") & " : " & LeChauffeur
End If
' Set c = Sheets("PersonneldeGardes").Range("A3:A" & Sheets("PersonneldeGardes").Range("A65536").End(xlUp).Row).Find(tablo1(i, j))
' If Not c Is Nothing Then
' LeChauffeur = c.Offset(0, 1)
' Sheets(Sheets.Count).[A12] = "Chauffeur de gardes le " & Format(tablo1(i, j), "dddd dd mmmm yyyy") & " : " & LeChauffeur
' End If
j = j + 1
Next Lig
.../...

Cibleo