Bonjour le Forum,
Ne sachant pas quelle partie du code vous intéressera, j'ai mis la
totalité
de la prose (que je n'ai pas écrite; c'est l'assemblage de 2 codes).
Dès que je valide le bouton de la UserForm, le message suivant s'affiche :
(Erreur d'exécution 381. Impossible de lire la propriété column de table
de
propriétés non valide.), et pourtant la copie des valeurs sur la feuille
de
calculs est correcte.
J'ai mis entre $ les lignes fautives.
Merci d'avance pour votre aide.
Jipé
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private DayLabel() As New lblClass, idx As Integer, m As Integer
'Const T As String = "Thierry's Démo sur www.Excel-Donwloads.com, May
2003"
Private Sub ScrollBar1_Change()
If Me.ScrollBar1 > m Then
iDate = DateAdd("m", 1, iDate)
Else
iDate = DateAdd("m", -1, iDate)
End If
m = Me.ScrollBar1: DP_UpDate
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim L As Integer
'Me.Caption = T
'trouve dernière ligne remplie
L = Sheets("Listes").Range("A65536").End(xlUp).Row
'mise des données dans la combo...
With Me
With .LbxNoms
.ColumnCount = 3 'il y a 3 colonne de A à C sur la feuille
.ColumnWidths = "120;0;0;0;0" 'Astuce, je mets la largeur à zéro pour
cacher les autres colonnes
.RowSource = "Listes!A3:C" & L 'Je mets toute la plage
.MatchEntry = fmMatchEntryFirstLetter 'Ici c'est pour faciliter la
recherche...
End With
End With
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth) /
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
CbxParts.RowSource = "Inscrits!Parts"
LbxNoms.RowSource = "Listes!Liste_Inscrits"
TxtPrenom.Value = ""
TxtNumero.Value = ""
CbxParts.Value = "Parts ?"
End Sub
Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe, c'est
celle du Nom !!!
With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With
End Sub
Friend Sub DP_UpDate()
Dim i As Integer, FirstDay As Integer
iDay = Day(iDate): iMonth = Month(iDate): iYear = Year(iDate)
FirstDay = Weekday(DateSerial(iYear, iMonth, 1)) - 1
For i = 0 To FirstDay - 1: Me.Controls("lblJ" & i).Visible = False: Next
i = 0
Do
i = i + 1
If Not IsDate(Month(iDate) & "/" & i & "/" & Year(iDate)) Then Exit Do
Me.Controls("lblJ" & FirstDay) = i
Me.Controls("lblJ" & FirstDay).Visible = True
If i = iDay Then HighLight FirstDay
FirstDay = FirstDay + 1
Loop
For i = FirstDay To UBound(DayLabel): Me.Controls("lblJ" & i).Visible > False: Next
TxtDate = Format(iDate, "dd-mmm-yy")
End Sub
Private Sub CommandButton1_Click()
Sheets("Inscrits").Select
ActiveSheet.Unprotect
Range("B1") = LbxNoms.Value
Range("C1") = TxtPrenom.Value
Range("D1") = TxtNumero.Value
Range("E1") = CbxParts.Value
Range("F1") = Format(TxtDate.Value, "dd-mmm-yy")
Range("B2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("B2").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("C2").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("C2").Select
Selection.Copy
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("F2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("F2").Select
Selection.Copy
Range("F65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("B1,C1,D1,E1,F1").Select
Worksheets("Inscrits").Columns("A:F").AutoFit
Selection.ClearContents
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth) /
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
LbxNoms.Value = ""
TxtNumero.Value = ""
TxtPrenom.Value = ""
CbxParts.Value = "Parts ?"
Range("A3").Select
Inscrit1.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub
Private Sub HighLight(ByVal Ctl As Byte)
Me.Controls("lblJ" & idx).BorderStyle = 0
Me.Controls("lblJ" & idx).FontBold = False
Me.Controls("lblJ" & Ctl).BorderStyle = 1
Me.Controls("lblJ" & Ctl).FontBold = True
idx = Ctl
Me.DateOfDay = Format(iDate, "d mmmm yyyy")
End Sub
Bonjour le Forum,
Ne sachant pas quelle partie du code vous intéressera, j'ai mis la
totalité
de la prose (que je n'ai pas écrite; c'est l'assemblage de 2 codes).
Dès que je valide le bouton de la UserForm, le message suivant s'affiche :
(Erreur d'exécution 381. Impossible de lire la propriété column de table
de
propriétés non valide.), et pourtant la copie des valeurs sur la feuille
de
calculs est correcte.
J'ai mis entre $ les lignes fautives.
Merci d'avance pour votre aide.
Jipé
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private DayLabel() As New lblClass, idx As Integer, m As Integer
'Const T As String = "Thierry's Démo sur www.Excel-Donwloads.com, May
2003"
Private Sub ScrollBar1_Change()
If Me.ScrollBar1 > m Then
iDate = DateAdd("m", 1, iDate)
Else
iDate = DateAdd("m", -1, iDate)
End If
m = Me.ScrollBar1: DP_UpDate
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim L As Integer
'Me.Caption = T
'trouve dernière ligne remplie
L = Sheets("Listes").Range("A65536").End(xlUp).Row
'mise des données dans la combo...
With Me
With .LbxNoms
.ColumnCount = 3 'il y a 3 colonne de A à C sur la feuille
.ColumnWidths = "120;0;0;0;0" 'Astuce, je mets la largeur à zéro pour
cacher les autres colonnes
.RowSource = "Listes!A3:C" & L 'Je mets toute la plage
.MatchEntry = fmMatchEntryFirstLetter 'Ici c'est pour faciliter la
recherche...
End With
End With
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth) /
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
CbxParts.RowSource = "Inscrits!Parts"
LbxNoms.RowSource = "Listes!Liste_Inscrits"
TxtPrenom.Value = ""
TxtNumero.Value = ""
CbxParts.Value = "Parts ?"
End Sub
Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe, c'est
celle du Nom !!!
With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With
End Sub
Friend Sub DP_UpDate()
Dim i As Integer, FirstDay As Integer
iDay = Day(iDate): iMonth = Month(iDate): iYear = Year(iDate)
FirstDay = Weekday(DateSerial(iYear, iMonth, 1)) - 1
For i = 0 To FirstDay - 1: Me.Controls("lblJ" & i).Visible = False: Next
i = 0
Do
i = i + 1
If Not IsDate(Month(iDate) & "/" & i & "/" & Year(iDate)) Then Exit Do
Me.Controls("lblJ" & FirstDay) = i
Me.Controls("lblJ" & FirstDay).Visible = True
If i = iDay Then HighLight FirstDay
FirstDay = FirstDay + 1
Loop
For i = FirstDay To UBound(DayLabel): Me.Controls("lblJ" & i).Visible > False: Next
TxtDate = Format(iDate, "dd-mmm-yy")
End Sub
Private Sub CommandButton1_Click()
Sheets("Inscrits").Select
ActiveSheet.Unprotect
Range("B1") = LbxNoms.Value
Range("C1") = TxtPrenom.Value
Range("D1") = TxtNumero.Value
Range("E1") = CbxParts.Value
Range("F1") = Format(TxtDate.Value, "dd-mmm-yy")
Range("B2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("B2").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("C2").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("C2").Select
Selection.Copy
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("F2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("F2").Select
Selection.Copy
Range("F65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("B1,C1,D1,E1,F1").Select
Worksheets("Inscrits").Columns("A:F").AutoFit
Selection.ClearContents
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth) /
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
LbxNoms.Value = ""
TxtNumero.Value = ""
TxtPrenom.Value = ""
CbxParts.Value = "Parts ?"
Range("A3").Select
Inscrit1.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub
Private Sub HighLight(ByVal Ctl As Byte)
Me.Controls("lblJ" & idx).BorderStyle = 0
Me.Controls("lblJ" & idx).FontBold = False
Me.Controls("lblJ" & Ctl).BorderStyle = 1
Me.Controls("lblJ" & Ctl).FontBold = True
idx = Ctl
Me.DateOfDay = Format(iDate, "d mmmm yyyy")
End Sub
Bonjour le Forum,
Ne sachant pas quelle partie du code vous intéressera, j'ai mis la
totalité
de la prose (que je n'ai pas écrite; c'est l'assemblage de 2 codes).
Dès que je valide le bouton de la UserForm, le message suivant s'affiche :
(Erreur d'exécution 381. Impossible de lire la propriété column de table
de
propriétés non valide.), et pourtant la copie des valeurs sur la feuille
de
calculs est correcte.
J'ai mis entre $ les lignes fautives.
Merci d'avance pour votre aide.
Jipé
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private DayLabel() As New lblClass, idx As Integer, m As Integer
'Const T As String = "Thierry's Démo sur www.Excel-Donwloads.com, May
2003"
Private Sub ScrollBar1_Change()
If Me.ScrollBar1 > m Then
iDate = DateAdd("m", 1, iDate)
Else
iDate = DateAdd("m", -1, iDate)
End If
m = Me.ScrollBar1: DP_UpDate
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim L As Integer
'Me.Caption = T
'trouve dernière ligne remplie
L = Sheets("Listes").Range("A65536").End(xlUp).Row
'mise des données dans la combo...
With Me
With .LbxNoms
.ColumnCount = 3 'il y a 3 colonne de A à C sur la feuille
.ColumnWidths = "120;0;0;0;0" 'Astuce, je mets la largeur à zéro pour
cacher les autres colonnes
.RowSource = "Listes!A3:C" & L 'Je mets toute la plage
.MatchEntry = fmMatchEntryFirstLetter 'Ici c'est pour faciliter la
recherche...
End With
End With
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth) /
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
CbxParts.RowSource = "Inscrits!Parts"
LbxNoms.RowSource = "Listes!Liste_Inscrits"
TxtPrenom.Value = ""
TxtNumero.Value = ""
CbxParts.Value = "Parts ?"
End Sub
Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe, c'est
celle du Nom !!!
With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With
End Sub
Friend Sub DP_UpDate()
Dim i As Integer, FirstDay As Integer
iDay = Day(iDate): iMonth = Month(iDate): iYear = Year(iDate)
FirstDay = Weekday(DateSerial(iYear, iMonth, 1)) - 1
For i = 0 To FirstDay - 1: Me.Controls("lblJ" & i).Visible = False: Next
i = 0
Do
i = i + 1
If Not IsDate(Month(iDate) & "/" & i & "/" & Year(iDate)) Then Exit Do
Me.Controls("lblJ" & FirstDay) = i
Me.Controls("lblJ" & FirstDay).Visible = True
If i = iDay Then HighLight FirstDay
FirstDay = FirstDay + 1
Loop
For i = FirstDay To UBound(DayLabel): Me.Controls("lblJ" & i).Visible > False: Next
TxtDate = Format(iDate, "dd-mmm-yy")
End Sub
Private Sub CommandButton1_Click()
Sheets("Inscrits").Select
ActiveSheet.Unprotect
Range("B1") = LbxNoms.Value
Range("C1") = TxtPrenom.Value
Range("D1") = TxtNumero.Value
Range("E1") = CbxParts.Value
Range("F1") = Format(TxtDate.Value, "dd-mmm-yy")
Range("B2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("B2").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("C2").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("C2").Select
Selection.Copy
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("F2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("F2").Select
Selection.Copy
Range("F65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("B1,C1,D1,E1,F1").Select
Worksheets("Inscrits").Columns("A:F").AutoFit
Selection.ClearContents
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth) /
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
LbxNoms.Value = ""
TxtNumero.Value = ""
TxtPrenom.Value = ""
CbxParts.Value = "Parts ?"
Range("A3").Select
Inscrit1.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub
Private Sub HighLight(ByVal Ctl As Byte)
Me.Controls("lblJ" & idx).BorderStyle = 0
Me.Controls("lblJ" & idx).FontBold = False
Me.Controls("lblJ" & Ctl).BorderStyle = 1
Me.Controls("lblJ" & Ctl).FontBold = True
idx = Ctl
Me.DateOfDay = Format(iDate, "d mmmm yyyy")
End Sub
Bonjour
As-tu testé ce que te renvoyait la syntaxe :
.LbxNoms.Column(1, .LbxNoms.ListIndex)
?
Parce que s'il y a une erreur (une valeur nulle), tu auras ce message.
Donc essaie de modifier en intégrant un test :
If Not IsNull(.LbxNoms.Column(1,.LbxNoms.ListIndex)
Cordialement
Pascal
"Jipé" a écrit dans le message de
news:%Bonjour le Forum,
Ne sachant pas quelle partie du code vous intéressera, j'ai mis la
totalitéde la prose (que je n'ai pas écrite; c'est l'assemblage de 2 codes).
Dès que je valide le bouton de la UserForm, le message suivant s'affiche
:
(Erreur d'exécution 381. Impossible de lire la propriété column de table
depropriétés non valide.), et pourtant la copie des valeurs sur la feuille
decalculs est correcte.
J'ai mis entre $ les lignes fautives.
Merci d'avance pour votre aide.
Jipé
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVallpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
LongPrivate Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long)
As
Long
Private DayLabel() As New lblClass, idx As Integer, m As Integer
'Const T As String = "Thierry's Démo sur www.Excel-Donwloads.com, May
2003"
Private Sub ScrollBar1_Change()
If Me.ScrollBar1 > m Then
iDate = DateAdd("m", 1, iDate)
Else
iDate = DateAdd("m", -1, iDate)
End If
m = Me.ScrollBar1: DP_UpDate
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim L As Integer
'Me.Caption = T
'trouve dernière ligne remplie
L = Sheets("Listes").Range("A65536").End(xlUp).Row
'mise des données dans la combo...
With Me
With .LbxNoms
.ColumnCount = 3 'il y a 3 colonne de A à C sur la feuille
.ColumnWidths = "120;0;0;0;0" 'Astuce, je mets la largeur à zéro
pour
cacher les autres colonnes
.RowSource = "Listes!A3:C" & L 'Je mets toute la plage
.MatchEntry = fmMatchEntryFirstLetter 'Ici c'est pour faciliter la
recherche...
End With
End With
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth)
/
2)Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
CbxParts.RowSource = "Inscrits!Parts"
LbxNoms.RowSource = "Listes!Liste_Inscrits"
TxtPrenom.Value = ""
TxtNumero.Value = ""
CbxParts.Value = "Parts ?"
End Sub
Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe,
c'est
celle du Nom !!!
With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With
End Sub
Friend Sub DP_UpDate()
Dim i As Integer, FirstDay As Integer
iDay = Day(iDate): iMonth = Month(iDate): iYear = Year(iDate)
FirstDay = Weekday(DateSerial(iYear, iMonth, 1)) - 1
For i = 0 To FirstDay - 1: Me.Controls("lblJ" & i).Visible = False:
Next
i = 0
Do
i = i + 1
If Not IsDate(Month(iDate) & "/" & i & "/" & Year(iDate)) Then Exit
Do
Me.Controls("lblJ" & FirstDay) = i
Me.Controls("lblJ" & FirstDay).Visible = True
If i = iDay Then HighLight FirstDay
FirstDay = FirstDay + 1
Loop
For i = FirstDay To UBound(DayLabel): Me.Controls("lblJ" & i).Visible
False: Next
TxtDate = Format(iDate, "dd-mmm-yy")
End Sub
Private Sub CommandButton1_Click()
Sheets("Inscrits").Select
ActiveSheet.Unprotect
Range("B1") = LbxNoms.Value
Range("C1") = TxtPrenom.Value
Range("D1") = TxtNumero.Value
Range("E1") = CbxParts.Value
Range("F1") = Format(TxtDate.Value, "dd-mmm-yy")
Range("B2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("B2").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("C2").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("C2").Select
Selection.Copy
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("F2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("F2").Select
Selection.Copy
Range("F65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("B1,C1,D1,E1,F1").Select
Worksheets("Inscrits").Columns("A:F").AutoFit
Selection.ClearContents
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth)
/
2)Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
LbxNoms.Value = ""
TxtNumero.Value = ""
TxtPrenom.Value = ""
CbxParts.Value = "Parts ?"
Range("A3").Select
Inscrit1.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub
Private Sub HighLight(ByVal Ctl As Byte)
Me.Controls("lblJ" & idx).BorderStyle = 0
Me.Controls("lblJ" & idx).FontBold = False
Me.Controls("lblJ" & Ctl).BorderStyle = 1
Me.Controls("lblJ" & Ctl).FontBold = True
idx = Ctl
Me.DateOfDay = Format(iDate, "d mmmm yyyy")
End Sub
Bonjour
As-tu testé ce que te renvoyait la syntaxe :
.LbxNoms.Column(1, .LbxNoms.ListIndex)
?
Parce que s'il y a une erreur (une valeur nulle), tu auras ce message.
Donc essaie de modifier en intégrant un test :
If Not IsNull(.LbxNoms.Column(1,.LbxNoms.ListIndex)
Cordialement
Pascal
"Jipé" <quaisako_44@msn.com> a écrit dans le message de
news:%23iE4ZrioEHA.4084@TK2MSFTNGP10.phx.gbl...
Bonjour le Forum,
Ne sachant pas quelle partie du code vous intéressera, j'ai mis la
totalité
de la prose (que je n'ai pas écrite; c'est l'assemblage de 2 codes).
Dès que je valide le bouton de la UserForm, le message suivant s'affiche
:
(Erreur d'exécution 381. Impossible de lire la propriété column de table
de
propriétés non valide.), et pourtant la copie des valeurs sur la feuille
de
calculs est correcte.
J'ai mis entre $ les lignes fautives.
Merci d'avance pour votre aide.
Jipé
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long)
As
Long
Private DayLabel() As New lblClass, idx As Integer, m As Integer
'Const T As String = "Thierry's Démo sur www.Excel-Donwloads.com, May
2003"
Private Sub ScrollBar1_Change()
If Me.ScrollBar1 > m Then
iDate = DateAdd("m", 1, iDate)
Else
iDate = DateAdd("m", -1, iDate)
End If
m = Me.ScrollBar1: DP_UpDate
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim L As Integer
'Me.Caption = T
'trouve dernière ligne remplie
L = Sheets("Listes").Range("A65536").End(xlUp).Row
'mise des données dans la combo...
With Me
With .LbxNoms
.ColumnCount = 3 'il y a 3 colonne de A à C sur la feuille
.ColumnWidths = "120;0;0;0;0" 'Astuce, je mets la largeur à zéro
pour
cacher les autres colonnes
.RowSource = "Listes!A3:C" & L 'Je mets toute la plage
.MatchEntry = fmMatchEntryFirstLetter 'Ici c'est pour faciliter la
recherche...
End With
End With
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth)
/
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
CbxParts.RowSource = "Inscrits!Parts"
LbxNoms.RowSource = "Listes!Liste_Inscrits"
TxtPrenom.Value = ""
TxtNumero.Value = ""
CbxParts.Value = "Parts ?"
End Sub
Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe,
c'est
celle du Nom !!!
With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With
End Sub
Friend Sub DP_UpDate()
Dim i As Integer, FirstDay As Integer
iDay = Day(iDate): iMonth = Month(iDate): iYear = Year(iDate)
FirstDay = Weekday(DateSerial(iYear, iMonth, 1)) - 1
For i = 0 To FirstDay - 1: Me.Controls("lblJ" & i).Visible = False:
Next
i = 0
Do
i = i + 1
If Not IsDate(Month(iDate) & "/" & i & "/" & Year(iDate)) Then Exit
Do
Me.Controls("lblJ" & FirstDay) = i
Me.Controls("lblJ" & FirstDay).Visible = True
If i = iDay Then HighLight FirstDay
FirstDay = FirstDay + 1
Loop
For i = FirstDay To UBound(DayLabel): Me.Controls("lblJ" & i).Visible
False: Next
TxtDate = Format(iDate, "dd-mmm-yy")
End Sub
Private Sub CommandButton1_Click()
Sheets("Inscrits").Select
ActiveSheet.Unprotect
Range("B1") = LbxNoms.Value
Range("C1") = TxtPrenom.Value
Range("D1") = TxtNumero.Value
Range("E1") = CbxParts.Value
Range("F1") = Format(TxtDate.Value, "dd-mmm-yy")
Range("B2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("B2").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("C2").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("C2").Select
Selection.Copy
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("F2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("F2").Select
Selection.Copy
Range("F65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("B1,C1,D1,E1,F1").Select
Worksheets("Inscrits").Columns("A:F").AutoFit
Selection.ClearContents
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth)
/
2)
Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
LbxNoms.Value = ""
TxtNumero.Value = ""
TxtPrenom.Value = ""
CbxParts.Value = "Parts ?"
Range("A3").Select
Inscrit1.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub
Private Sub HighLight(ByVal Ctl As Byte)
Me.Controls("lblJ" & idx).BorderStyle = 0
Me.Controls("lblJ" & idx).FontBold = False
Me.Controls("lblJ" & Ctl).BorderStyle = 1
Me.Controls("lblJ" & Ctl).FontBold = True
idx = Ctl
Me.DateOfDay = Format(iDate, "d mmmm yyyy")
End Sub
Bonjour
As-tu testé ce que te renvoyait la syntaxe :
.LbxNoms.Column(1, .LbxNoms.ListIndex)
?
Parce que s'il y a une erreur (une valeur nulle), tu auras ce message.
Donc essaie de modifier en intégrant un test :
If Not IsNull(.LbxNoms.Column(1,.LbxNoms.ListIndex)
Cordialement
Pascal
"Jipé" a écrit dans le message de
news:%Bonjour le Forum,
Ne sachant pas quelle partie du code vous intéressera, j'ai mis la
totalitéde la prose (que je n'ai pas écrite; c'est l'assemblage de 2 codes).
Dès que je valide le bouton de la UserForm, le message suivant s'affiche
:
(Erreur d'exécution 381. Impossible de lire la propriété column de table
depropriétés non valide.), et pourtant la copie des valeurs sur la feuille
decalculs est correcte.
J'ai mis entre $ les lignes fautives.
Merci d'avance pour votre aide.
Jipé
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVallpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As
LongPrivate Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long)
As
Long
Private DayLabel() As New lblClass, idx As Integer, m As Integer
'Const T As String = "Thierry's Démo sur www.Excel-Donwloads.com, May
2003"
Private Sub ScrollBar1_Change()
If Me.ScrollBar1 > m Then
iDate = DateAdd("m", 1, iDate)
Else
iDate = DateAdd("m", -1, iDate)
End If
m = Me.ScrollBar1: DP_UpDate
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim L As Integer
'Me.Caption = T
'trouve dernière ligne remplie
L = Sheets("Listes").Range("A65536").End(xlUp).Row
'mise des données dans la combo...
With Me
With .LbxNoms
.ColumnCount = 3 'il y a 3 colonne de A à C sur la feuille
.ColumnWidths = "120;0;0;0;0" 'Astuce, je mets la largeur à zéro
pour
cacher les autres colonnes
.RowSource = "Listes!A3:C" & L 'Je mets toute la plage
.MatchEntry = fmMatchEntryFirstLetter 'Ici c'est pour faciliter la
recherche...
End With
End With
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth)
/
2)Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
CbxParts.RowSource = "Inscrits!Parts"
LbxNoms.RowSource = "Listes!Liste_Inscrits"
TxtPrenom.Value = ""
TxtNumero.Value = ""
CbxParts.Value = "Parts ?"
End Sub
Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe,
c'est
celle du Nom !!!
With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With
End Sub
Friend Sub DP_UpDate()
Dim i As Integer, FirstDay As Integer
iDay = Day(iDate): iMonth = Month(iDate): iYear = Year(iDate)
FirstDay = Weekday(DateSerial(iYear, iMonth, 1)) - 1
For i = 0 To FirstDay - 1: Me.Controls("lblJ" & i).Visible = False:
Next
i = 0
Do
i = i + 1
If Not IsDate(Month(iDate) & "/" & i & "/" & Year(iDate)) Then Exit
Do
Me.Controls("lblJ" & FirstDay) = i
Me.Controls("lblJ" & FirstDay).Visible = True
If i = iDay Then HighLight FirstDay
FirstDay = FirstDay + 1
Loop
For i = FirstDay To UBound(DayLabel): Me.Controls("lblJ" & i).Visible
False: Next
TxtDate = Format(iDate, "dd-mmm-yy")
End Sub
Private Sub CommandButton1_Click()
Sheets("Inscrits").Select
ActiveSheet.Unprotect
Range("B1") = LbxNoms.Value
Range("C1") = TxtPrenom.Value
Range("D1") = TxtNumero.Value
Range("E1") = CbxParts.Value
Range("F1") = Format(TxtDate.Value, "dd-mmm-yy")
Range("B2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("B2").Select
Selection.Copy
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("C2").Select
ActiveCell.FormulaR1C1 = "=PROPER(R[-1]C)"
Range("C2").Select
Selection.Copy
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("F2").Select
ActiveCell.FormulaR1C1 = "=UPPER(R[-1]C)"
Range("F2").Select
Selection.Copy
Range("F65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Range("B1,C1,D1,E1,F1").Select
Worksheets("Inscrits").Columns("A:F").AutoFit
Selection.ClearContents
If iFlag Then
Dim lngMe&, hndMe&, Offset As Single
Offset = Me.Height - Me.InsideHeight - ((Me.Width - Me.InsideWidth)
/
2)Me.Height = Me.Height - Offset
hndMe = FindWindow(vbNullString, Me.Caption)
lngMe = GetWindowLong(hndMe, -16) And Not &HC00000
Call SetWindowLong(hndMe, -16, lngMe)
Call DrawMenuBar(hndMe)
End If
Dim i As Integer, Ctl As Control
For Each Ctl In Me.Controls
If Left(Ctl.Name, 4) = "lblJ" Then
i = Val(Mid(Ctl.Name, 5))
ReDim Preserve DayLabel(0 To i)
Set DayLabel(i).DayGroup = Ctl
End If
Next Ctl
Me.ScrollBar1 = m: iDate = Date: DP_UpDate
LbxNoms.Value = ""
TxtNumero.Value = ""
TxtPrenom.Value = ""
CbxParts.Value = "Parts ?"
Range("A3").Select
Inscrit1.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End Sub
Private Sub HighLight(ByVal Ctl As Byte)
Me.Controls("lblJ" & idx).BorderStyle = 0
Me.Controls("lblJ" & idx).FontBold = False
Me.Controls("lblJ" & Ctl).BorderStyle = 1
Me.Controls("lblJ" & Ctl).FontBold = True
idx = Ctl
Me.DateOfDay = Format(iDate, "d mmmm yyyy")
End Sub