Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Erreur d'exécution 381. Impossible de lire la propriété column.........................

5 réponses
Avatar
Jipé
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 _
:=False, Transpose:=False

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 _
:=False, Transpose:=False

Range("D1").Select
Selection.Copy
Range("D65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range("E1").Select
Selection.Copy
Range("E65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

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 _
:=False, Transpose:=False

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

5 réponses

Avatar
papou
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
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




Avatar
michdenis
Bonjour Jipé,


With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With


Essaie quelque chose dans le genre :

With Me.LbxNoms
Me.TxtPrenom = .List(.ListIndex, 1)
Me.TxtNumero = .List(.ListIndex, 2)
End With

ATTENTION : La propriété "LIST" d'un contrôle "ListBox" retourne un tableau de base 0 , c'est-à-dire que le premier item du
tableau est List(0,0) . Le premier zéro représente la ligne, le deuxième zéro représente la colonne.

Comme tu as renseigné ton "listbox" en utilisant la propriété "RowSource" en définissant le nom de la feuille et de la plage
de cellules de référence (Exemple : Feuil1!A1:C10), tu dois te souvenir que la première ligne et la première colonne d'une
cellule d'une feuille de calcul est 1 et non zéro comme dans un tableau des entrées de données de ton contrôle Listbox. Tu
dois alors tenir compte de l'existence du décallage de 1 entre le numéro de la ligne de la cellule et Listindex du contrôle
listbox. Il en est de meme pour la colonne.

La forme générale est donc :

'forme générale

Me.TxtNumero = .List(.ListIndex, 2)
Me.TxtNumero = .List(lignedelacellule-1, colonnedelacellule-1)



Salutations!





"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 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
Avatar
papou
Re
Si cela peut t'aider :
En complément, après test, j'ai ce type d'erreur si je saisi dans le contôle
une valeur qui ne fait pas partie de la liste.
Cordialement
Pascal


"papou" <cestpasbonpapou@çanonplus44.fr> a écrit dans le message de
news:
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
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








Avatar
michdenis
En supplément,

Si tu exécutes ton code sans qu'au moins un item aie été sélectionné, évidemment ta procédure va se planter par que la
propriété ListIndex du contrôle ListBox retourne la valeur -1 dans ce cas et cela ne correspond à aucune entrée de ta liste
évidemment.

Au lancement de ta procédure, il s'agit simplement de vérifier la valeur du "ListIndex"

If Me.listbox1.Listindex = -1 then
Msgbox "Annulé"
exit sub
else
Ta procédure
end if



Salutations!






With Me
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
End With


Essaie quelque chose dans le genre :

With Me.LbxNoms
Me.TxtPrenom = .List(.ListIndex, 1)
Me.TxtNumero = .List(.ListIndex, 2)
End With

ATTENTION : La propriété "LIST" d'un contrôle "ListBox" retourne un tableau de base 0 , c'est-à-dire que le premier item du
tableau est List(0,0) . Le premier zéro représente la ligne, le deuxième zéro représente la colonne.

Comme tu as renseigné ton "listbox" en utilisant la propriété "RowSource" en définissant le nom de la feuille et de la plage
de cellules de référence (Exemple : Feuil1!A1:C10), tu dois te souvenir que la première ligne et la première colonne d'une
cellule d'une feuille de calcul est 1 et non zéro comme dans un tableau des entrées de données de ton contrôle Listbox. Tu
dois alors tenir compte de l'existence du décallage de 1 entre le numéro de la ligne de la cellule et Listindex du contrôle
listbox. Il en est de meme pour la colonne.

La forme générale est donc :

'forme générale

Me.TxtNumero = .List(.ListIndex, 2)
Me.TxtNumero = .List(lignedelacellule-1, colonnedelacellule-1)



Salutations!





"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 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
Avatar
Jipé
Re le Forum,

Merci à tous. Le code, tel que ci-dessous fonctionne.

Private Sub LbxNoms_Change()
'Synchronisation des TextBox (Nb la Column 0 de la ComboBox existe, c'est
celle du Nom !!!)
If Me.LbxNoms.ListIndex = -1 Then
MsgBox "Saisie effectuée"
Exit Sub
Else
With Me
.TxtPrenom = .LbxNoms.Column(1, .LbxNoms.ListIndex)
.TxtNumero = .LbxNoms.Column(2, .LbxNoms.ListIndex)
End With
End If
End Sub

Je n'ai peût-être pas tout compris voire rien du tout..................mais
...............bon!

Pour ce qui est de:
"Si tu exécutes ton code sans qu'au moins un item aie été sélectionné,
évidemment ta procédure va se planter par que la
propriété ListIndex du contrôle ListBox retourne la valeur -1 dans ce cas et
cela ne correspond à aucune entrée de ta liste
évidemment."

or, je suis bien obligé de sélectionner au moins un item, vu
qu'obligatoirement je sélectionnais un nom de LbxNoms pour effectuer ma
saisie !!!!!!!!!!

Merci encore. Jipé