Rien que pour vos yeux [VBA]

Staple1600

XLDnaute Barbatruc
Bonsoir à tous


1) Ouvrez la pièce jointe

2) Eteignez la lumière

2) Cliquez sur le triangle

4) :)


PS: remerciements à l'auteur du code VBA

PS2: si vous avez des codes VBA similaires, faites-moi signe.

Merci
 

JNP

XLDnaute Barbatruc
Re : Rien que pour vos yeux [VBA]

Bonsoir Stapple1600 :),
Joli le sapin. Mais est-ce normal que Kapersky me renvoie un "Comportement analogue à Key Logger détecté"?
Bonne soirée :cool:
 

Staple1600

XLDnaute Barbatruc
Re : Rien que pour vos yeux [VBA]

Bonsoir JNP, le fil, le forum

EDITION: Décembre 2012 : Je remets le code VBA (qui semble avoir été vaporisé pour cause de virus infondé, tout comme la PJ d'ailleurs ;) ?)
(mais je ne suis pas sur que c'était forcément ce code-ci)
Mais c'est toujours sur la base des travaux de Sierpinski

Voici juste le module (qui je le répète est inoffensif sauf pour les phobiques des sapins de Noel ;) )

Code:
Sub SheetTriangle()
'auteur: D. Kusleika
Dim CurrX As Double, CurrY As Double
Dim Vertices(1 To 3, 1 To 2) As Double, NextVert&, wsh As Worksheet
    
Vertices(1, 1) = 128
Vertices(1, 2) = 1
Vertices(2, 1) = 1
Vertices(2, 2) = 227
Vertices(3, 1) = 256
Vertices(3, 2) = 227
    
Set wsh = ThisWorkbook.Worksheets.Add
wsh.Cells.RowHeight = 1.5: wsh.Cells.ColumnWidth = 0.17
'Start at the third vertex
NextVert = 3
CurrX = Vertices(NextVert, 1)
CurrY = Vertices(NextVert, 2)
    'loop ten thousand times
   For i = 1 To 50000
        NextVert = Int(3 * Rnd + 1)  'pick a random vertext
       GetNewPoint CurrX, CurrY, Vertices(NextVert, 1), _
            Vertices(NextVert, 2) 'find the midway point
       PlacePointWsh CLng(CurrX), CLng(CurrY), wsh 'color a cell at that point
   Next i
End Sub
Code:
Sub GetNewPoint(ByRef CurrX As Double, ByRef CurrY As Double, ByVal RandX As Double, ByVal RandY As Double)
CurrX = CurrX + ((RandX - CurrX) / 2): CurrY = CurrY + ((RandY - CurrY) / 2)
End Sub
Code:
Sub PlacePointWsh(ByVal NewX As Long, ByVal NewY As Long, ByRef wsh As Worksheet)
wsh.Cells(NewY, NewX).Interior.Color = Choose(Int(7 * Rnd + 1), _
vbBlack, vbRed, vbBlue, vbGreen, vbYellow, vbMagenta, vbWhite)
End Sub
Tu verras ( vous verrez pour ceux qui passeront dans ce fil) qu'il n'y a aucun virus inside.

Bonne fin de soirée à tous.
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Rien que pour vos yeux [VBA]

Re le forum :),
Ne t'inquiètes pas, Stapple, je suis bien sûr convaincu que le fichier ne comprends pas de virus. Je signalais juste que Kapersky signalait la présence d'un Key Logger, donc d'une surveillance de l'activité souris et clavier.
Que les autres forumeurs soient rassurés, il peuvent charger leur arbre de Noël pour les fêtes.
Bonne soirée :cool:
 

Discussions similaires

Statistiques des forums

Discussions
312 361
Messages
2 087 613
Membres
103 607
dernier inscrit
lolo1970