petit problème dans le code mais ou?

[biquet13]

Bonjour le forum...

je reviens vers vous car je ne me dépatouille plus du planning que vous m'avez aidé a faire..
je me retrouve devant un soucis maintenant..
quand je suis sur la feuille "mois" (dans l'exemple : janvier)
que je me met sur la ligne "nom du soignant"
et que je clic sur les boutons remplissage ligne ou remplissage planning..
et bien... "Rien"..lol..
et pourtant.. me semble que le code soit bon..

si vous pouviez tester et verifier..

cordialement..

 

[jp14]

Re : petit problème dans le code mais ou?

Bonsoir

Ci dessous un code à tester

Sub Remplissageligne()
Dim w1 As String
Dim nom_soignant As String
Dim cellule As Range, plage As Range
Dim d As Range
Dim col As Byte
col = 3 ' première colonne
w1 = ActiveSheet.Name
nom_soignant = ActiveCell.Value

If nom_soignant = "" Then
Call MsgBox("Vous n'apez pas sélectionné un soignant", vbInformation, Application.Name)

Exit Sub
End If
With Worksheets("Base_Soignants")
dl1 = .Range("a65536").End(xlUp).Row + 2
Set plage = .Range(col1 & lidep1 & "a8:a" & .Range("a65536").End(xlUp).Row)
For Each cellule In plage
     If cellule.Value = nom_soignant Then Exit For
Next cellule
For Each d In .Range("c" & cellule.Row & ":ag" & cellule.Row)
'For Each d In .Range(Cells(cellule.Row, 6), Cells(cellule.Row, 33))
   'd.Select
   If d <> "" Then Worksheets(w1).Cells(ActiveCell.Row, col) = d
    col = col + 1
Next d
End With
   Worksheets(w1).Activate
End Sub

JP

 

[biquet13]

Re : petit problème dans le code mais ou?

bonjour le forum, .. jp14

merci pour ta réponse..
je viens de tester mais les 3 premieres colonnes du planning dans la feuille "janvier" ne se remplissent pas.. et dans la premiere colonne apparait "IDE"..

++

 

[jp14]

Re : petit problème dans le code mais ou?

Bonjour

Code à modifier

For Each d In .Range([COLOR="Red"]"f"[/COLOR] & cellule.Row & ":ag" & cellule.Row)

JP

 

[biquet13]

Re : petit problème dans le code mais ou?

arf.. c'est pas encore ca.. lol
les premieres colonnes se remplissent certe
mais maintenant ce sont les dernieres qui sont vides
et les valeurs ne sont pas ranger au bon endroit dans le planning.. 🙂

 

[jp14]

Re : petit problème dans le code mais ou?

Bonjour

Dans la première feuille les colonnes vont de B à AG
Dans la deuxième les colonnes vont de F à AG.
Comment doit gérer le transfert.

JP

 

[biquet13]

Re : petit problème dans le code mais ou?

re bonjour

le planning dans la feuille "base soignant" est représenté par un roulement sur 4 semaine (représenté par les chiffre 1 -4 en haut de la feuille)
ces chiffre apparaissent aussi dans la feuille "janvier"
en fait si le soignant travaille (11.5) le vendredi de la semaine 1 il faut que 11.5 apparaissent sur le planning de la feuille janvier au vendredi de la semaine 1
ainsi desuite..;

je sais pas si c'est clair lol...

 

[jp14]

Re : petit problème dans le code mais ou?

Bonjour
Un nouveau code à tester

Sub Remplissageligne()
Dim w1 As String
Dim nom_soignant As String
Dim cellule As Range, plage As Range
Dim d As Range
Dim col As Byte
Dim lig As Long
Dim val1 As Variant

col = 3 ' première colonne
w1 = ActiveSheet.Name
nom_soignant = ActiveCell.Value

If nom_soignant = "" Then
Call MsgBox("Vous n'apez pas sélectionné un soignant", vbInformation, Application.Name)

Exit Sub
End If
With Worksheets("Base_Soignants")
dl1 = .Range("a65536").End(xlUp).Row + 2
Set plage = .Range("a8:a" & .Range("a65536").End(xlUp).Row)
End With
For Each cellule In plage
     If cellule.Value = nom_soignant Then Exit For
Next cellule
lig = cellule.Row

With Sheets(w1)
Set plage = .Range("c9:ag9")
For Each cellule In plage
   val1 = recherche("Base_Soignants", CStr(cellule.Value), CStr(cellule.Offset(2, 0).Value), lig)
   .Cells(ActiveCell.Row, cellule.Column) = val1
Next cellule
End With
   Worksheets(w1).Activate
End Sub
Private Function recherche(£feul As String, £val1 As String, £val2 As String, £lig As Long)
Dim £plage As Range
Dim £cellule As Range
With Sheets(£feul)
recherche = ""
Set £plage = .Range("f1:ag1")

For Each cellule In £plage
     If CStr(cellule.Value) = £val1 And LCase(CStr(cellule.Offset(1, 0).MergeArea(1))) = £val2 Then
     recherche = cellule.Offset(£lig - 1, 0).Value
     Exit Function
     End If
Next cellule

End With
End Function

JP

 

[biquet13]

Re : petit problème dans le code mais ou?

Hello jp14.. le forum...

et bien il semblerait que cela fonctionne...
je te remerci pour cette aide..
merci beaucoups..

vais pouvoir continuer dans la mise en place de ce planning..


;-)

 

[jp14]

Re : petit problème dans le code mais ou?

Bonjour

Une des causes de dysfonctionnement de programme est parfois difficile à trouver.
Les jours dans les deux feuilles ne sont pas écrits de la même manière.

JP

 

[biquet13]

Re : petit problème dans le code mais ou?

re bonsoir le forum, jp14

je vais avoir besoin de tes lumieres encore une fois pour adapter le code

Sub Remplissageligne()
Dim w1 As String
Dim nom_soignant As String
Dim cellule As Range, plage As Range
Dim d As Range
Dim col As Byte
Dim lig As Long
Dim val1 As Variant

col = 3 ' première colonne
w1 = ActiveSheet.Name
nom_soignant = ActiveCell.Value

If nom_soignant = "" Then
Call MsgBox("Vous n'apez pas sélectionné un soignant", vbInformation, Application.Name)

Exit Sub
End If
With Worksheets("Base_Soignants")
dl1 = .Range("a65536").End(xlUp).Row + 2
Set plage = .Range("a8:a" & .Range("a65536").End(xlUp).Row)
End With
For Each cellule In plage
     If cellule.Value = nom_soignant Then Exit For
Next cellule
lig = cellule.Row

With Sheets(w1)
Set plage = .Range("c9:ag9")
For Each cellule In plage
   val1 = recherche("Base_Soignants", CStr(cellule.Value), CStr(cellule.Offset(2, 0).Value), lig)
   .Cells(ActiveCell.Row, cellule.Column) = val1
Next cellule
End With
   Worksheets(w1).Activate
End Sub
Private Function recherche(£feul As String, £val1 As String, £val2 As String, £lig As Long)
Dim £plage As Range
Dim £cellule As Range
With Sheets(£feul)
recherche = ""
Set £plage = .Range("f1:ag1")

For Each cellule In £plage
     If CStr(cellule.Value) = £val1 And LCase(CStr(cellule.Offset(1, 0).MergeArea(1))) = £val2 Then
     recherche = cellule.Offset(£lig - 1, 0).Value
     Exit Function
     End If
Next cellule

End With
End Function

que tu m'as donné plus haut...
pour l'adapter au planning (qui fonctionne) mais le code n'est peut etre pas des plus simple..

merci à toi..

cordialement

 

[jp14]

Re : petit problème dans le code mais ou?

Bonjour

Ci joint le fichier modifié, les cellules fusionnées posent toujours des problèmes.

A tester

JP

 

[biquet13]

Re : petit problème dans le code mais ou?

bonsoir jp14, le forum..

merci encore pour ton aide...
encore une fois c'est super..
et cela fonctionne
je vais quand même essayé de voir si je ne peux pas faire sans les cellules fusionnées.. mais le principal c'est que ce soit fonctionnel comme cela..

encore merci..
++