[ChTi160]

Donc celui là n'aidera personne ,si ce n'est moi pour comprendre comment cà fonctionne
A+++
Jean Marie

[salim]

bonjour à tous

petit test de message

[Hervé]

bonsoir

petit essai

Salut Hervé

[salim]

test de message

salim

[salim]

re test d'avatar

[ChTi160]

Re essai pas evident
Bonjour à toutes et à tous:x
le Gras,Italic,Underligne
ChTI160
je ne sais pas si l'on obtient ces mises en formes en cliquant sur les Balises si oui comment?
les smyleys, il faut aussi taper les symboles ou il suffit de cliquer dessus pour les inclure.:lol:
bon déjà ça et ensuite on verra
A+++
Jean Marie

Oups 'un test'

dur dur la vie de testeur

je suis mal
et je le sais !!!!!!!!!!!!!!!!

[ChTi160]

Bonjour àtoutes et à tous

pourquoi lorsque je post dans le Salon deXLD je me retrouve sur le Forum
oups c'est le Binzzzzzzzzzz ou alors j'ai rien compri encore

[ChTi160]

j'ai compris c'est la page Accueil Générale donc bon j'aarête les testes sa me Gonfle

[ChTi160]

Teste formatage sylvain

Sub Transfert() 'pour Marion 08/05/2005
Dim i As Byte, L As Byte, Derlgn As Byte, L2 AsByte
Dim derlgn2 AsLong
Dim myArray AsVariant
Dim TabTemp()
Dim TabTemp2()
Dim maplage As Range, cel As Range
Dim x As Byte, C AsByte
myArray = Array('2', '23', '44', '65', '85') 'limites supérieures des plages RM FLAN etc
For i = 0 To UBound(myArray)
ReDimPreserve TabTemp2(i)
TabTemp2(i) = Range('D' & myArray(i)) 'rempli un tableau des Valeurs RM FLAN en fonction de myArray

Next
With Sheets('Feuil3')
Derlgn = .Range('C65536').End(xlUp).Row
'si la plage feuil3 n'est pas vide on l'efface
If .Cells(2, 3) <> '' Then
.Range(.Cells(2, 3), .Cells(Derlgn, 6)).ClearContents
.Range(.Cells(2, 3), .Cells(Derlgn, 6)).Interior.ColorIndex = 35
Else
With Sheets('Feuil2')

For i = 0 To UBound(myArray) - 1

'on détermine la plage par type RM FLAN etc en fonction des valeurs de myArray
Set maplage = Range(Cells(myArray(i) + 3, 2), Cells(Cells(myArray(i + 1), 2).End(xlUp).Row, 2))
If Cells(myArray(i) + 3, 2) = '' Then
ReDim TabTemp(1, 3)
x = 1
TabTemp(x, 0) = '-'
TabTemp(x, 1) = '-'
TabTemp(x, 2) = '-'
TabTemp(x, 3) = '-'
x = x + 1
GoTo suite
Else
'MsgBox Cells (myArray(i + 1), 2).End(xlUp).Row 'test permet de visualiser la limite inférieur de la zone maplage
x = 1 '
ReDim TabTemp(maplage.Count, 3)
ForEach cel In maplage
If cel.Value = '' ThenGoTo suivant
'ici on rempli un tableau avec les valeurs de la Zone maplage
TabTemp(x, 0) = cel.Value
TabTemp(x, 1) = cel.Offset(0, 15)
TabTemp(x, 2) = cel.Offset(0, 16)
TabTemp(x, 3) = cel.Offset(0, 17)
x = x + 1
Next
suite:
'Ici copie par Zone
With Worksheets('Feuil3')
Application.ScreenUpdating = False
.Cells(2, 3) = 'carton' 'rempli la cellule H2
.Cells(2, 3).Font.ColorIndex = 5
Derlgn = .Range('C65536').End(xlUp).Row + 1
.Cells(Derlgn, 3) = TabTemp2(L2)
.Cells(Derlgn, 3).Interior.ColorIndex = 6
For L = 1 To UBound(TabTemp, 1)
Derlgn = .Range('C65536').End(xlUp).Row + 1
For C = 0 To UBound(TabTemp, 2)
If C = 4 Then
.Cells(Derlgn, C + 3) = Format(CDate(TabTemp(L, C).Value), 'hh:mm:ss')
Else
.Cells(Derlgn, C + 3) = TabTemp(L, C)
EndIf
Next
Next
suivant:
L2 = L2 + 1
EndWith
EndIf
Next
EndWith
EndIf
EndWith
Application.ScreenUpdating = True
EndSub

Amicalement
Jean Marie

Message édité par: ChTi160, à: 09/05/2005 23:29

Message édité par: ChTi160, à: 09/05/2005 23:34