Utilitaire en Béta test

[Hervé]

Re:Test

salut hellboy

l'amitié me suffit.

Pour le nombre de post, chuuuuut, c'est ma combine barbatruc.

Option Explicit
Sub Bouton1_QuandClic()
Dim ws As Worksheet
Dim tablo()
Dim data As Collection
Dim i As Integer
Dim j As Integer
Dim c As Range
Dim derligne As Integer
Dim x As Integer, l As Integer
Dim somme As Double
Set data = New Collection
x = 1
l = 2
ReDim tablo(1 To 6, 1 To x)
For Each ws In Worksheets
&nbsp; &nbsp; &nbsp; &nbsp; If ws.Name <> 'bilan' Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; With ws
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; derligne = .Range('a65536').End(xlUp).Row
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; For Each c In .Range('a2:a' & derligne)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If c <> '' Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; On Error Resume Next
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; data.Add CStr(c.Text), CStr(c.Text)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; On Error GoTo 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; x = x + 1
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ReDim Preserve tablo(1 To 6, 1 To x)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; For i = 1 To 6
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; tablo(i, x) = .Cells(c.Row, i)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Next i
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Next c
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With
&nbsp; &nbsp; &nbsp; &nbsp; End If
Next ws
With Sheets('bilan')
For i = 1 To data.Count
&nbsp; &nbsp; &nbsp; &nbsp; For j = 1 To UBound(tablo, 2)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If data(i) = tablo(1, j) Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; somme = somme + tablo(5, j)
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; &nbsp; &nbsp; Next j
&nbsp; &nbsp; &nbsp; &nbsp; .Cells(l, 7) = data(i)
&nbsp; &nbsp; &nbsp; &nbsp; .Cells(l, 8) = somme
&nbsp; &nbsp; &nbsp; &nbsp; somme = 0
&nbsp; &nbsp; &nbsp; &nbsp; l = l + 1
Next i
End With
&nbsp; &nbsp;
End Sub

bye

Message édité par: Hervé, à: 01/10/2005 19:16

Message édité par: Hervé, à: 01/10/2005 21:14

Message édité par: Hervé, à: 01/10/2005 21:18

Message édité par: Hervé, à: 01/10/2005 21:31

 

[Hellboy]

Re:Test

&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Colonne A
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ligne 1 à 3
1
2
3

&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Colonne B
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ligne 1
=SOMME(A1:A3)

&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Colonne C
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ligne 3
=NB(A1:B3)

Message édité par: Hellboy, à: 13/10/2005 01:48

 

[Hellboy]

Re:Test

Public Const strRepZip&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; As String * 10 = 'C:\XLD\Zip'

[file name=classeur2_20051013044049.zip size=3930]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classeur2_20051013044049.zip[/file]

 

[PascalXLD]

Re:Test

Bonjour

Moi je suis interressé par ta mise à jour Hellboy.

Hervé tu assumes tes trucs je ne te les supprime pas et de toute façon tu peux dire que c'est ton clone

Bonne journée

 

[Hervé]

Re:Test

Bonjour tout le monde

Pascal, je remarque que c'est la deuxième fois que tu refuses de voler à mon secours.

Dois-je en conclure que l'entraide dont tu fais magistralement preuve sur le forum m'est interdite ?

Faut-il que je m'adresse au clone de pascal76 afin de bénéficier de ces bonnes grâces ?

Que d'interrogation, avec si peux de réponse !!!!

Salut

Hervé, pas moi mais l'autre

 

[PascalXLD]

Re:Test

Re

Si si Hervé bien sûr tu peux compter sur mon aide mais ....

Maintenant je me demande toujours qui j'aide vraiment ??

Hervé ?? son clone ??

Dans le doute que fais-je ??

Je detruis ces codes ?? Mais si ça se trouve c'est le clone qui demande à supprimer des codes du vrai Hervé ??
Alors si je le fais Hervé me dira : 'Mais tu n'as pas vu que c'était des codes concis, qui fonctionnaient, ... donc qui venaient de moi !!!!!'

Et voilà que je ne sais plus quoi faire :unsure: :unsure:

Moi aussi tant de questions sans réponse avec ton clone qui hante le forum :whistle:

Bonne journée

 

[Hellboy]

Re:Test

Bonjour Hervé, bonjour Pascal76

Pascal76, patience, patience.

Si les attentes sont trop grandes, il me faudra remettre la date de relâchement encore une fois, de peur je ne saurai atteindre ce niveau d'attente.

Le seul qui me comprend de ce côté, c'est mon jumeau de codage. Mais entre toi et moi, il aurait vraiment besoin qu'on lui donne une façon d'amélioré son rendement académique. Je suis tellement débordé ces dernier temps, que je m'en veux de l'avoir laissé à lui-même. Il faut être fort et garder l'espoir qu'il va s'en sortir par ses propre moyen.

Mais si je peux me permettre, Pascal76, il serait préférable de ne pas pas trop l'encourager a faire appel a Papa Pascal76 a chaque fois qu'il se sent pris dans le pétrin. ce ne serait pas l'aider. enfin c'est mon humble opinion. C'est un brave garçon mais qui a aussi ses caprices.

C'est pour ton bien Hervé que je dis ça!

 

[Hellboy]

Re:Test

Bonjour Hervé, bonjour Pascal76

Pascal76, patience, patience.

Si les attentes sont trop grandes, il me faudra remettre la date de relâchement encore une fois, de peur je ne saurai atteindre ce niveau d'attente.

Le seul qui me comprend de ce côté, c'est mon jumeau de codage. Mais entre toi et moi, il aurait vraiment besoin qu'on lui donne une façon d'amélioré son rendement académique. Je suis tellement débordé ces dernier temps, que je m'en veux de l'avoir laissé à lui-même. Il faut être fort et garder l'espoir qu'il va s'en sortir par ses propre moyen.

Mais si je peux me permettre, Pascal76, il serait préférable de ne pas pas trop l'encourager a faire appel a Papa Pascal76 a chaque fois qu'il se sent pris dans le pétrin. ce ne serait pas l'aider. enfin c'est mon humble opinion. C'est un brave garçon mais qui a aussi ses caprices.

C'est pour ton bien Hervé que je dis ça!

 

[Hellboy]

Re:Test

re

Les clones contre attaque, oh! nooooooooooooooooooooooon

soyez vigilant !

Je me demande si ce n'est pas plutôt un Glitch de la Matrice ?

 

[Hellboy]

Re:Test

Message édité par: Hellboy, à: 27/10/2005 16:11

 

[Hellboy]

Re:Test

Message édité par: Hellboy, à: 27/10/2005 16:10

 

[Hellboy]

Re:Test

'&nbsp; &nbsp; Cette routine permet d'insérer du texte sur le Presse-papiers
Public Sub PutOnClipboard(ByVal strClip As String)
&nbsp; &nbsp; On Error Resume Next
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; With MyDataObj
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .SetText strClip
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .PutInClipboard
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With
&nbsp; &nbsp; On Error GoTo 0
End Sub

 

[Hellboy]

Re:Test

Public Sub PutOnClipboard(ByVal strClip As String)
&nbsp; &nbsp; On Error Resume Next
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; With MyDataObj
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .SetText strClip
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .PutInClipboard
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With
&nbsp; &nbsp; On Error GoTo 0
End Sub

 

[Hellboy]

Re:Test

[face=Courier New] If Not Procedure Then
'Check if there's anything selected at all, if not, select the entire module
If Lf = Ht And Tp = Wd Then
If MsgBox('Do you want to copy the entire module?', vbExclamation + vbYesNo, AppName) = vbYes Then
Lf = 1
Ht = CodeMod.CountOfLines
Else
Exit Sub
End If
End If
Else
Tmp = CodeMod.ProcOfLine(Lf, vbext_pk_Proc)
On Error Resume Next
For i = 1 To 4
Err.Clear
Tp = CodeMod.ProcStartLine(Tmp, Choose(i, vbext_pk_Proc, vbext_pk_Get, vbext_pk_Let, vbext_pk_Set))
If Err.Number = 0 Then
Wd = Tp + CodeMod.ProcCountLines(Tmp, Choose(i, vbext_pk_Proc, vbext_pk_Get, vbext_pk_Let, vbext_pk_Set))
If Tp <= Lf And Wd >= Lf Then
Lf = Tp
Ht = Wd
Exit For
End If
End If
Next i
On Error GoTo 0
End If[/face]

Message édité par: Hellboy, à: 14/11/2005 22:40

 

[Hervé]

Re:Test

bonjour

faite comme si je n'etais pas là

j'ai fini

salut

Message édité par: hervé, à: 05/12/2005 15:36

Message édité par: hervé, à: 05/12/2005 15:37

Message édité par: hervé, à: 05/12/2005 15:40