OVH Cloud OVH Cloud

Pb Macro

21 réponses
Avatar
rs
Jai un souci sur un fichier contenant des macros, j'ai fait un débog et elle
bloque sur le DTPICKER avec msg objet requiq mais je ne comprned pas du tout
Merci pour votre aide, ci joint la macro

Private Sub UserForm_Initialize()

Dim nom_utilisateur As String
Dim start_plage As Variant
Dim i As Integer
Dim j As Integer
Dim jour_en_cours As Date
ActiveSheet.Unprotect Password:=admin_psw
ActiveWorkbook.Unprotect Password:=admin_psw

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours

j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
'Call mef_fichier
ActiveSheet.Protect Password:=admin_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:=admin_psw, structure:=True, Windows:=True

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ActiveWorkbook.Protect Password:=admin_psw, structure:=True, Windows:=True
ActiveSheet.Protect Password:=admin_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

Private Sub UserForm_Activate()
j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
UserForm6.Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
End Sub

10 réponses

1 2 3
Avatar
Daniel
Bonjour.
J'ai testé sans rencontrer de problème ?
Cordialement.
Daniel
"rs" a écrit dans le message de news:

Jai un souci sur un fichier contenant des macros, j'ai fait un débog et
elle
bloque sur le DTPICKER avec msg objet requiq mais je ne comprned pas du
tout
Merci pour votre aide, ci joint la macro

Private Sub UserForm_Initialize()

Dim nom_utilisateur As String
Dim start_plage As Variant
Dim i As Integer
Dim j As Integer
Dim jour_en_cours As Date
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours

j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
'Call mef_fichier
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

Private Sub UserForm_Activate()
j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
UserForm6.Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
End Sub





Avatar
JLuc
*Bonjour rs*,
Est ce que tes 2 DTPicker sont directement sur le formulaire ou à
l'interieur d'une frame ou autre ?

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours


--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O

Avatar
rs
Et pourtant je n'ai pas moyens de l'xécuter il me met Erreur 424 objet requis
Ci joint l'intégralité, aurais tu une idée
'Public Const annee_en_cours As Date = Year(Date)
'Public Const jour_en_cours As Date = FormatDateTime(Now, vbShortDate)
Public Const gestion_psw As Variant = "mhd"

Public Const admin_psw As Variant = "mce"
Public Const admin_user As Variant = "mce"

Public Sub Auto_Open()


UserForm1.Show

ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub

Function user_mot_de_passe(Optional user As Variant, Optional psw As
Variant, Optional verif_psw_change As Variant)
Static verif_psw As Variant
Dim nom_utilisateur As String
Dim start_plage As Variant
Dim i, j As Integer
Dim col As Integer
Dim ligne As Integer
Dim psw_cel As Variant

Dim Msg, Msg2, Msg3, Msg4, Style, Title, message As String

Msg = "VOTRE PASSWORD EST INCORRECT" ' Define message.
Msg2 = "VEUILLEZ ENTRER VOTRE NOM D'UTILISATEUR ET VOTRE PASSWORD" & Chr(10)
& " CLIQUER SUR GO" ' Define message.
Msg3 = "VEUILLEZ VERIFIER VOTRE USER" & Chr(10) & " OU FAITE VOUS
ENREGISTRER" ' Define message.
Msg4 = "VEUILLEZ SELECTIONNER UN USER DANS LA LISTE" & Chr(10) & " OU FAITE
VOUS ENREGISTRER" ' Define message.

ActiveSheet.Unprotect Password:­min_psw
Style = vbOKOnly ' Define buttons.
Title = "Message" ' Define title.
If IsMissing(verif_psw_change) = False Then
If verif_psw_change = 0 Then
verif_psw = 0
End If
End If
If verif_psw = 0 Then
If IsMissing(user) = False Then
If user = "" Then
message = MsgBox(Msg2, Style, Title)
Exit Function
End If

If psw <> "" Then
j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address

With Range(start_plage, nom_utilsateur)
Set c = .Find(user, LookIn:=xlFormulas)
'Set c = .Find(user, LookIn:=xlValues)
If Not c Is Nothing Then
ligne = c.Row
col = c.Column
If Cells(ligne, col + 1) = psw Or psw = admin_psw Or psw =
gestion_psw Then

If Cells(ligne, col + 1) = psw Then
user_mot_de_passe = 2
verif_psw = 2
ElseIf psw = admin_psw Then
user_mot_de_passe = 1
verif_psw = 1
ElseIf psw = gestion_psw Then
user_mot_de_passe = 4
verif_psw = 4
End If
Else
message = MsgBox(Msg, Style, Title)
user_mot_de_passe = 3
End If



Else
message = MsgBox(Msg4, Style, Title)
End If
End With
Else

'message = MsgBox(Msg4, Style, Title)

End If
Else

message = MsgBox(Msg2, Style, Title)
user_mot_de_passe = 3
End If

ElseIf verif_psw = 4 Then
user_mot_de_passe = 4
ElseIf verif_psw = 2 Then
user_mot_de_passe = 2
ElseIf verif_psw = 1 Then
user_mot_de_passe = 1
End If
'ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
End Function
Function changer_mot_de_passe(Optional user As Variant, Optional psw As
Variant, Optional new_psw As Variant)

Dim Msg, Msg2, Msg3, Style, Title, message As String
Dim j As Integer
Msg = "VOTRE PASSWORD EST INCORRECT" ' Define message.
Msg2 = "VEUILLER ENTRER VOTRE NOM D'UTILISATEUR ET VOTRE PASSWORD" & Chr(10)
& " CLIQUER SUR GO" ' Define message.
Msg3 = "VOTRE MOT DE PASSE A ETE CHANGE AVEC SUCCES" ' Define message.
Style = vbOKOnly ' Define buttons.
Title = "Message" ' Define title.
ActiveSheet.Unprotect Password:­min_psw
If IsMissing(user) = False Then

If psw <> "" & new_psw <> "" Then
j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address

With Range(start_plage, nom_utilsateur)
Set c = .Find(user, LookIn:=xlFormulas)
ligne = c.Row
col = c.Column
If Cells(ligne, col + 1) = psw Or psw = admin_psw Then
changer_mot_de_passe = 2
Cells(ligne, col + 1) = new_psw
message = MsgBox(Msg3, Style, Title)

Else
message = MsgBox(Msg, Style, Title)
changer_mot_de_passe = 3
End If
End With
Else

'message = MsgBox(Msg2, Style, Title)

End If
Else
message = MsgBox(Msg2, Style, Title)
changer_mot_de_passe = 3
End If
'ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Function
Function liste_utilsateur()
Dim i As Integer
i = 228
While Cells(i, 1) <> ""
i = i + 1

Wend
liste_utilsateur = i
End Function



"Daniel" wrote:

Bonjour.
J'ai testé sans rencontrer de problème ?
Cordialement.
Daniel
"rs" a écrit dans le message de news:

Jai un souci sur un fichier contenant des macros, j'ai fait un débog et
elle
bloque sur le DTPICKER avec msg objet requiq mais je ne comprned pas du
tout
Merci pour votre aide, ci joint la macro

Private Sub UserForm_Initialize()

Dim nom_utilisateur As String
Dim start_plage As Variant
Dim i As Integer
Dim j As Integer
Dim jour_en_cours As Date
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours

j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
'Call mef_fichier
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

Private Sub UserForm_Activate()
j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
UserForm6.Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
End Sub










Avatar
rs
Bjr
Ils sont dans une form

"JLuc" wrote:

*Bonjour rs*,
Est ce que tes 2 DTPicker sont directement sur le formulaire ou à
l'interieur d'une frame ou autre ?

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours


--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O






Avatar
rs
Ci joint mon code ci jms tu connais bien le truc. Merci

Private Sub Cbliste_nom_Change()
Dim utilsateur As Variant
Dim app_function As Variant
Dim nom_utilisateur As String
Dim start_plage As Variant

Dim j As Integer
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur


utilsateur = Cbliste_nom.Value
app_function = user_mot_de_passe(utilsateur, psw:="", verif_psw_change:=0)
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub

Public Sub cdgo_Click()
Static user As Variant
Static psw As Variant
Dim test As Variant
user = Cbliste_nom
psw = TextBox2
test = user_mot_de_passe(user, psw, verif_psw_change:=0)

TextBox2.Value = ""
If test = 3 Then
Exit Sub
End If
End Sub

Private Sub CommandButton1_Click()
Dim tableau_date As Date
'Dim cellule_date As Range
Dim cellule_date As Range

Dim start_date As Date
Dim year_value_start As Integer
Dim month_value_start As Integer
Dim end_date As Date
Dim year_value_end As Integer
Dim month_value_end As Integer
Dim row_date As Variant
Dim col_date As Variant
Dim essai2 As Variant
Dim essai3 As Variant
Dim tab_date(0 To 365) As Date
Dim comp_date As Date
Dim nom_utilsateur As Variant
Dim mot_de_passe As Variant
Dim message2 As String
Dim Msg, Msg2, Msg3, Msg4, Msg5, Style, Title, message As String
Dim row_date_a_remplir(0 To 1000) As Integer
Dim col_date_a_remplir(0 To 1000) As Integer
Dim i, j, k, l As Integer
i = 0
j = 0
k = 0
l = 0
p = 0
ActiveSheet.Unprotect Password:­min_psw


end_date = DTPicker2.Value
year_value_end = Year(DTPicker1.Value)
month_value_end = Month(DTPicker1.Value)


start_date = DTPicker1.Value
year_value_start = Year(DTPicker1.Value)
month_value_start = Month(DTPicker1.Value)
'call

'creation tableau des dates comprisent entre DTPicker1 et DTPicker2
i = 0
'cas start_date est egal à end_date
tab_date(0) = start_date
If start_date = end_date Then
tab_date(0) = start_date
i = 1
End If
'cas start_date est plus grand que end_date
If start_date < end_date Then
While comp_date < end_date
tab_date(i) = start_date + i
comp_date = tab_date(i)
i = i + 1
Wend
End If
'cas start_date est plus grand que end_date
If start_date > end_date Then
While comp_date < start_date
tab_date(i) = end_date + i
comp_date = tab_date(i)
i = i + 1
Wend
End If

Msg = "VEUILLER ENTRER VOTRE NOM D'UTILISATEUR" ' Define message.
Style = vbOKOnly ' Define buttons.
Title = "Message" ' Define title.
Msg2 = "LE PORTABLE EST DEJA RETENU POUR CES DATES" & Chr(10) & "VEUILLEZ
RENTRER DES NOUVELLES DATES"
Msg3 = "ATTENTION LE PORTABLE EST DEJA RETENU POUR CES DATES" & Chr(10) & "
VOULEZ VOUS QUAND MEME CONTINUER "
Msg4 = "VOUS N'AVEZ PAS LES DROITS POUR EFFECTUER UNE RESERVATION"
Msg5 = "VOTRE RESEVATION A BIEN ETE PRIS EN COMPTE"

If user_mot_de_passe = 3 Then
Exit Sub
End If
If user_mot_de_passe = 2 Then

nom_utilsateur = Cbliste_nom.Value

If nom_utilsateur = "" Then
message = MsgBox(Msg, Style, Title)
Exit Sub
End If



For j = 0 To (i - 1)
start_date = tab_date(j)
For Each cellule_date In
[B10:H27,J10:P27,B31:H48,J31:P48,B52:H69,J52:P69,B73:H90,J73:P90,B94:H111,J94:P111,B115:H132,J115:P132,B136:H153,J136:P153]

If cellule_date.Value <> "" Then

If IsDate(cellule_date) = True Then
If cellule_date.Value = start_date Then

row_date = cellule_date.Row
col_date = cellule_date.Column
p = 1
If Cells(row_date + 1, col_date) <> "" Then
If Cells(row_date + 1, col_date) <> nom_utilsateur Then
message2 = MsgBox(Msg2, Style, Title)
Exit Sub
End If
Else:
row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
k = k + 1


End If
End If
End If
End If
Next
Next

For l = 0 To (k - 1)
Cells(row_date_a_remplir(l), col_date_a_remplir(l)).Interior.ColorIndex = 3
Cells(row_date_a_remplir(l), col_date_a_remplir(l)) = Cbliste_nom.Value
Next
If p = 1 Then
message = MsgBox(Msg5, Style, Title)
End If

If k > 0 Then
Application.Goto Reference:=Range(Cells(row_date_a_remplir(0),
col_date_a_remplir(0)), Cells(row_date_a_remplir(0), col_date_a_remplir(0))),
Scroll:úlse
End If

End If

If user_mot_de_passe = 1 Then

nom_utilsateur = Cbliste_nom.Value

If nom_utilsateur = "" Then
message = MsgBox(Msg, Style, Title)
Exit Sub
End If
For j = 0 To (i - 1)
start_date = tab_date(j)
For Each cellule_date In
[B10:H27,J10:P27,B31:H48,J31:P48,B52:H69,J52:P69,B73:H90,J73:P90,B94:H111,J94:P111,B115:H132,J115:P132,B136:H153,J136:P153]
'For Each cellule_date In [B10:H20;J10:P20;B25:H35;J25:P35,]
If cellule_date.Value <> "" Then
If IsDate(cellule_date) = True Then

If cellule_date.Value = start_date Then
'If cellule_date.Value = tab_date(i) Then
row_date = cellule_date.Row
col_date = cellule_date.Column
p = 1
If Cells(row_date + 1, col_date) <> "" Then
If Cells(row_date + 1, col_date) <> nom_utilsateur Then

row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
k = k + 1
m = 1
End If

Else:
row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
'case_a_remplir(k) = Range(Cells(row_date + 1, col_date)).Address
k = k + 1

'Range(Cells(row_date + 1, col_date)).Address
End If
End If
End If
End If
Next
Next

If m = 1 Then
message = MsgBox(Msg3, vbOKCancel, Title)
If message = vbCancel Then
Exit Sub
End If
If message = vbOK Then
End If
End If

For l = 0 To (k - 1)
Cells(row_date_a_remplir(l), col_date_a_remplir(l)).Interior.ColorIndex = 3
Cells(row_date_a_remplir(l), col_date_a_remplir(l)) = Cbliste_nom.Value
Next
If p = 1 Then
message = MsgBox(Msg5, Style, Title)
End If

If k > 0 Then
Application.Goto Reference:=Range(Cells(row_date_a_remplir(0),
col_date_a_remplir(0)), Cells(row_date_a_remplir(0), col_date_a_remplir(0))),
Scroll:úlse
End If

End If
If user_mot_de_passe = 4 Then
message = MsgBox(Msg4, Style, Title)
End If
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
End Sub

Private Sub CommandButton2_Click()
Dim tableau_date As Date
Dim cellule_date As Range

Dim start_date As Date
Dim year_value_start As Integer
Dim month_value_start As Integer
Dim end_date As Date
Dim year_value_end As Integer
Dim month_value_end As Integer
Dim row_date As Variant
Dim col_date As Variant
Dim essai2 As Variant
Dim essai3 As Variant
Dim tab_date(0 To 365) As Date
Dim comp_date As Date
Dim nom_utilsateur As Variant
Dim mot_de_passe As Variant
Dim message2 As String
Dim Msg, Msg2, Msg3, Msg4, Msg5, Style, Title, message As String
Dim row_date_a_remplir(0 To 1000) As Integer
Dim col_date_a_remplir(0 To 1000) As Integer
Dim i, j, k, l As Integer
i = 0
j = 0
k = 0
l = 0
m = 0
p = 0

ActiveSheet.Unprotect Password:­min_psw

end_date = DTPicker2.Value
year_value_end = Year(DTPicker1.Value)
month_value_end = Month(DTPicker1.Value)


start_date = DTPicker1.Value
year_value_start = Year(DTPicker1.Value)
month_value_start = Month(DTPicker1.Value)

'creation tableau des dates comprisent entre DTPicker1 et DTPicker2
i = 0
'cas start_date est egal à end_date
If start_date = end_date Then
tab_date(0) = start_date
i = 1
End If
'cas start_date est plus grand que end_date
If start_date < end_date Then
While comp_date < end_date
tab_date(i) = start_date + i
comp_date = tab_date(i)
i = i + 1
Wend
End If
'cas start_date est plus grand que end_date
If start_date > end_date Then
While comp_date < start_date
tab_date(i) = end_date + i
comp_date = tab_date(i)
i = i + 1
Wend
End If

Msg = "VEUILLER ENTRER VOTRE NOM D'UTILISATEUR" ' Define message.
Style = vbOKOnly ' Define buttons.
Title = "Message" ' Define title.
Msg2 = "LE PORTABLE EST DEJA RETENU POUR CES DATES" & Chr(10) & "VOUS NE
POUVEZ PAS SUPPRIMER LA RESERVATION"
Msg3 = "ATTENTION LE PORTABLE EST DEJA RETENU POUR CES DATES" & Chr(10)
& " VOULEZ VOUS QUAND MEME CONTINUER "
Msg4 = "VOUS N'AVEZ PAS LES DROITS POUR EFFECTUER UNE RESERVATION"
Msg5 = "VOTRE ANNULATION A BIEN ETE PRISE EN COMPTE"

If user_mot_de_passe = 3 Then
Exit Sub
End If

If user_mot_de_passe = 2 Then

nom_utilsateur = Cbliste_nom.Value





If nom_utilsateur = "" Then
message = MsgBox(Msg, Style, Title)
Exit Sub
End If


For j = 0 To (i - 1)
start_date = tab_date(j)
For Each cellule_date In
[B10:H27,J10:P27,B31:H48,J31:P48,B52:H69,J52:P69,B73:H90,J73:P90,B94:H111,J94:P111,B115:H132,J115:P132,B136:H153,J136:P153]
'For Each cellule_date In [B10:H20;J10:P20;B25:H35;J25:P35,]
If cellule_date.Value <> "" Then
If IsDate(cellule_date) = True Then

If cellule_date.Value = start_date Then
'If cellule_date.Value = tab_date(i) Then
row_date = cellule_date.Row
col_date = cellule_date.Column
p = 1
If Cells(row_date + 1, col_date) <> "" Then
If Cells(row_date + 1, col_date) <> nom_utilsateur Then
message2 = MsgBox(Msg2, Style, Title)
Exit Sub
End If
If Cells(row_date + 1, col_date) = nom_utilsateur Then
row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
k = k + 1
End If
Else:
row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
'case_a_remplir(k) = Range(Cells(row_date + 1, col_date)).Address
k = k + 1
'Range(Cells(row_date + 1, col_date)).Address
End If
End If
End If
End If
'Range(Cells(row_date, col_date), Cells(row_date + 1,
col_date)).Interior.ColorIndex = 3
' Cells(row_date + 1, col_date) = Cbliste_nom.Value
' cellule_date.Interior.ColorIndex = 3
Next
Next

For l = 0 To (k - 1)
Cells(row_date_a_remplir(l), col_date_a_remplir(l)).Interior.ColorIndex = 2
Cells(row_date_a_remplir(l), col_date_a_remplir(l)) = ""
Next
If p = 1 Then
message = MsgBox(Msg5, Style, Title)
End If

If k > 0 Then
Application.Goto Reference:=Range(Cells(row_date_a_remplir(0),
col_date_a_remplir(0)), Cells(row_date_a_remplir(0), col_date_a_remplir(0))),
Scroll:úlse
End If

'End If
End If

If user_mot_de_passe = 1 Then
nom_utilsateur = Cbliste_nom.Value

If nom_utilsateur = "" Then
message = MsgBox(Msg, Style, Title)
Exit Sub
End If
For j = 0 To (i - 1)
start_date = tab_date(j)
For Each cellule_date In
[B10:H27,J10:P27,B31:H48,J31:P48,B52:H69,J52:P69,B73:H90,J73:P90,B94:H111,J94:P111,B115:H132,J115:P132,B136:H153,J136:P153]
'For Each cellule_date In [B10:H20;J10:P20;B25:H35;J25:P35,]
If cellule_date.Value <> "" Then
If IsDate(cellule_date) = True Then

If cellule_date.Value = start_date Then
'If cellule_date.Value = tab_date(i) Then
row_date = cellule_date.Row
col_date = cellule_date.Column
p = 1
If Cells(row_date + 1, col_date) <> "" Then
If Cells(row_date + 1, col_date) <> nom_utilsateur Then

row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
k = k + 1
m = 1
End If
If Cells(row_date + 1, col_date) = nom_utilsateur Then

row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
k = k + 1

End If
Else:
row_date_a_remplir(k) = cellule_date.Row + 1
col_date_a_remplir(k) = cellule_date.Column
'case_a_remplir(k) = Range(Cells(row_date + 1, col_date)).Address
k = k + 1
'Range(Cells(row_date + 1, col_date)).Address
End If
End If
End If
End If
Next
Next

If m = 1 Then
message = MsgBox(Msg3, vbOKCancel, Title)
If message = vbCancel Then
Exit Sub
End If
If message = vbOK Then
End If
End If
For l = 0 To (k - 1)
Cells(row_date_a_remplir(l), col_date_a_remplir(l)).Interior.ColorIndex = 2
Cells(row_date_a_remplir(l), col_date_a_remplir(l)) = ""
Next

If p = 1 Then
message = MsgBox(Msg5, Style, Title)
End If

If k > 0 Then
Application.Goto Reference:=Range(Cells(row_date_a_remplir(0),
col_date_a_remplir(0)), Cells(row_date_a_remplir(0), col_date_a_remplir(0))),
Scroll:úlse
End If

End If
If user_mot_de_passe = 4 Then
message = MsgBox(Msg4, Style, Title)
End If
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

Private Sub CommandButton3_Click()
'Application.CommandBars(FORMULAIRE).Visible = True
UserForm1.Hide
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

Exit Sub
End Sub


Private Sub CommandButton4_Click()
'ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub


Private Sub empreint_Click()
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

UserForm4.Show
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub

Private Sub Image1_Click()
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

UserForm2.Show
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub


Private Sub Image2_Click()
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

UserForm3.Show


End Sub

Private Sub UserForm_Initialize()

Dim nom_utilisateur As String
Dim start_plage As Variant
Dim i As Integer
Dim j As Integer
Dim jour_en_cours As Date
ActiveSheet.Unprotect Password:­min_psw
ActiveWorkbook.Unprotect Password:­min_psw

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours

j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
'Call mef_fichier
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ActiveWorkbook.Protect Password:­min_psw, structure:=True, Windows:=True
ActiveSheet.Protect Password:­min_psw, DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

Private Sub UserForm_Activate()
j = liste_utilsateur
nom_utilsateur = Range(Cells(j, 1), Cells(j, 1)).Address
start_plage = Range("A228").Address
'Cbliste_nom.RowSource = "B2:" & nom_utilsateur
UserForm6.Cbliste_nom.RowSource = start_plage & ":" & nom_utilsateur
End Sub



"JLuc" wrote:

*Bonjour rs*,
Est ce que tes 2 DTPicker sont directement sur le formulaire ou à
l'interieur d'une frame ou autre ?

jour_en_cours = FormatDateTime(Now, vbShortDate)
DTPicker1.Value = jour_en_cours
DTPicker2.Value = jour_en_cours


--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O






Avatar
JLuc
*Bonjour rs*,

Ci joint mon code ci jms tu connais bien le truc. Merci
Plutot que de mettre ton code (qui est relativement long) si tu mettais

ton classeur en passant par www.cjoint.com ? On pourrait tester et
rencontrer le même probleme que toi, donc savoir ce qui coince et te
depanner plus facilement ;-)

--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O

Avatar
rs
C'est fait le fichier a été compressé son nom réservation pc portable.zip
http://cjoint.com/?eAlQm1suP1
Merci pour ton aide
Qaudn je le lance il m'indique une erreur 424, objet requis

"JLuc" wrote:

*Bonjour rs*,

Ci joint mon code ci jms tu connais bien le truc. Merci
Plutot que de mettre ton code (qui est relativement long) si tu mettais

ton classeur en passant par www.cjoint.com ? On pourrait tester et
rencontrer le même probleme que toi, donc savoir ce qui coince et te
depanner plus facilement ;-)

--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O






Avatar
Daniel
Ca serait bien d'avoir le mot de passe du code.
Daniel
"rs" a écrit dans le message de news:

C'est fait le fichier a été compressé son nom réservation pc portable.zip
http://cjoint.com/?eAlQm1suP1
Merci pour ton aide
Qaudn je le lance il m'indique une erreur 424, objet requis

"JLuc" wrote:

*Bonjour rs*,

Ci joint mon code ci jms tu connais bien le truc. Merci
Plutot que de mettre ton code (qui est relativement long) si tu mettais

ton classeur en passant par www.cjoint.com ? On pourrait tester et
rencontrer le même probleme que toi, donc savoir ce qui coince et te
depanner plus facilement ;-)

--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O








Avatar
JLuc
*Bonjour Daniel*,
C'est "mce" (je l'ai trouver dans le code joint, dans la declaration
des constantes) :-)

Ca serait bien d'avoir le mot de passe du code.
Daniel
"rs" a écrit dans le message de news:

C'est fait le fichier a été compressé son nom réservation pc portable.zip
http://cjoint.com/?eAlQm1suP1
Merci pour ton aide
Qaudn je le lance il m'indique une erreur 424, objet requis

"JLuc" wrote:

*Bonjour rs*,

Ci joint mon code ci jms tu connais bien le truc. Merci
Plutot que de mettre ton code (qui est relativement long) si tu mettais

ton classeur en passant par www.cjoint.com ? On pourrait tester et
rencontrer le même probleme que toi, donc savoir ce qui coince et te
depanner plus facilement ;-)

-- ____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O







--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O




Avatar
rs
Oups désolé mdp= mce

"Daniel" wrote:

Ca serait bien d'avoir le mot de passe du code.
Daniel
"rs" a écrit dans le message de news:

C'est fait le fichier a été compressé son nom réservation pc portable.zip
http://cjoint.com/?eAlQm1suP1
Merci pour ton aide
Qaudn je le lance il m'indique une erreur 424, objet requis

"JLuc" wrote:

*Bonjour rs*,

Ci joint mon code ci jms tu connais bien le truc. Merci
Plutot que de mettre ton code (qui est relativement long) si tu mettais

ton classeur en passant par www.cjoint.com ? On pourrait tester et
rencontrer le même probleme que toi, donc savoir ce qui coince et te
depanner plus facilement ;-)

--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O













1 2 3