HACKVBACON & FORMULALACON - Let's play ! ;-)

[Staple1600]

Bonsoir le fil, le forum

Si...
Chapeau bas

PS: J'ai pas compris les trois souris dans le commentaire
J'ai donc fait un CTRL+PAUSE

 

[Si...]

Re

PS: J'ai pas compris les trois souris dans le commentaire
J'ai donc fait un CTRL+PAUSE ou Alt + F11

Oups, c'est ma façon de dire qu'il faut cliquer plusieurs fois sur la cellule !

Nota : il semblerait que Application.Speech.Speak mettent la pagaille (mais j'attendais une confirmation)!

 

[Si...]

Bon_jour

Staple, merci pour la partition.

Dis-moi si, avec toutes ses lignes de code, je l'ai bien déchiffrée et bien "trompété".

 

[Modeste geedee]

Bonsour®

Re


Nota : il semblerait que Application.Speech.Speak mettent la pagaille (mais j'attendais une confirmation)!

Application.Speech.Speak n'a rien à voir là-dedans ...

KADO .A LA KHON ???

..

 

[Staple1600]

Bonjour le fil, le forum

Dans la série, on a les références* qu'on peut
(*cf le nom de cette macro)

Const ante As String = "Staple1600"
Const Adulte_Age As String = "18 ans"
Sub Mortimer_Shuman_Tribute()
Dim p As Range, c As Range, gonL As Long
gonL = CLng(Asc(Mid(ante, 1, 1)) + VBA.Right(ante, 4) - Asc(Chr(101)) + Val(Split(Adulte_Age)(0))) / 10
Set p = Range(Cells(1 + 1, 4 - 2), Cells(gonL + 123, gonL + 123))
p.ColumnWidth = 0.08: p.RowHeight = 0.75: p.Interior.Color = vbWhite
Application.ScreenUpdating = False: Application.EnableEvents = False
[B1] = 1: [B1].Interior.Color = vbBlack
p.FormulaR1C1 = "=+MOD((R[-1]C+R[-1]C[-1]),2)": p.Value = p.Value
For Each c In p
If c = 1 Then
c.Interior.Color = vbBlack
End If
Next
Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

NB:Les autres, les ceusses qui ont des accointances avec les mathématiques* vous diront qu'on est loin des Bermudes

*: Et là pour le coup, on est plus dans le truc à la con
Donc je retourne sérieusement faire l'idiot dans VBE

 

[Staple1600]

Re

Suite du précédent post, on varie les plaisirs et on mets de la couleur

Spoiler: C'est Zou la macro à lancer

Sub Zou()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
abc
def
'parametres de ghi : par défaut False = NB si True alors couleurs
'ghi ' en couleurs
'ghi True ' NB
ghi
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub abc()
With ActiveSheet
.Cells.Clear
With .[B2:DX125]
    .Cells.Font.Color = vbWhite: .Cells.Interior.Color = vbWhite
    .ColumnWidth = 0.08: .RowHeight = 0.75
End With
End With
End Sub
Private Sub def()
Dim p As Range: Set p = [B2:DX125]: Cells.ClearContents
p.FormulaR1C1 = "=IF(SUM(R[-1]C[-1]:R[-1]C[1])=1,1,""@"")": [A1] = 1: p.Value = p.Value
End Sub
Private Sub ghi(Optional no As Boolean = False)
Dim Rng As Range, R As Byte, V As Byte, B As Byte
If no = False Then
ActiveSheet.[B2:DX125].SpecialCells(2, 2).Interior.Color = vbBlack
Else
Randomize 1600
On Error Resume Next
For Each Rng In ActiveSheet.[B2:DX125].SpecialCells(2, 2)
R = Application.WorksheetFunction.RandBetween(0, 255)
V = Application.WorksheetFunction.RandBetween(0, 255)
B = Application.WorksheetFunction.RandBetween(0, 255)
Rng.Interior.Color = VBA.RGB(R, V, B)
Next
End If
End Sub

Bonne nuit à tous

 

[job75]

Bonsoir Jean-Marie et les autres,

Ce genre de truc moi ch'peux pas, ça prend trop la tête.

Je me contente de pister les records à battre :

https://www.excel-downloads.com/threads/procedure-trop-grande.20002978/

2804 lignes, pas trouvé mieux.

A+

 

[Staple1600]

Bonsoir le fil , le forum, job75

@job75
Tu as testé le petit code du message#21?
Toi qui aime les maths (enfin je crois) ça devrait te plaire
Et je suis sûr que tu saurais proposer un code mieux écrit ou plus optimisé que le mien

 

[Si...]

Bon_jour

Tu as testé le petit code du message#21?
Et je suis sûr que tu saurais proposer un code mieux écrit ou plus optimisé que le mien

De la couleur (?) oui mais pas seulement black & white.
Si tu veux un code moins alambiqué (hors thème du fil)

Spoiler

 Dim p As Range, R As Range
Sub ZouZou()
  ActiveWindow.Zoom = 300
  With Application
      .ScreenUpdating = 0: .EnableEvents = 0: .DisplayFullScreen = 1
      [A1] = 1
      Set p = [B2:DX125]: p.Clear
      p.Interior.Color = vbBlack
      p.ColumnWidth = 0.08: p.RowHeight = 0.75
      p.FormulaR1C1 = "=IF(SUM(R[-1]C[-1]:R[-1]C[1])=1,1,"""")": p = p.Value
      [A1] = ""
      For Each R In p.SpecialCells(2)
          R.Interior.ColorIndex = Application.RandBetween(2, 50)
      Next
      [BK64].Select
      .EnableEvents = 1: .ScreenUpdating = 1
  End With
End Sub

 

[Staple1600]

Bonjour le fil, le forum

Je suis resté bouche bée devant ce code
(et je cherche toujours à comprendre sa logique)
A tester sur un classeur vierge
(en écoutant la chanson N°3 de la face A de BBH 75)

Spoiler: Let it be !

Option Compare Text
Option Explicit
Option Base 0

'auteur du code original: Taylor Scott
Public Sub SuperbeNon()
On Error GoTo 0

Dim part%, length%, M&, seed&, dir&, word&, carry&, bx!, by!, BRUSH, COLOR
Application.ScreenUpdating = False
Let COLOR = Array(&H89E2FF, &H459EE9, &H5AA5, 0)
Let BRUSH = Array( _
        778, 14270, 12187, 1835, 3644, 62875, 35473, 6923, _
        3773, 37752, 47166, 45146, 28853, 640, 53425, 40146, _
        8339, 8348, 15633, 9942, 57113, 38901, 37027, 41799, _
        35575, 2137, 10669, 41772, 32252, 3453, 54650, 12369, _
        54321, 21547, 45634, 45332, 35478, 10516, 45297, 21292, _
        1043, 2569, 16059, 59670, 6263, 47330, 44146, 32967, _
        21056, 36156, 16047, 44387, 7700, 45629, 9103, 49275, _
        44957, 12590, 38606, 9639, 40503, 11332, 11193, 8505)

Let dir = 0
Let carry = 0
Let seed = &H7EC80000

Let Cells.Interior.COLOR = 0
Let Cells.ColumnWidth = 2

For part = 0 To 63 Step 1

    Let word = BRUSH(part)
    Let seed = (seed And &HFFFF0000) Or word

    Let bx = word And 255
    Let by = Int(word / (2 ^ 8)) And 255

    For length = 0 To (64 - part) * 32 - 1 Step 1

        Let carry = seed And &H80000000
        Let M = seed And &H40000000
        Let seed = (seed And &H3FFFFFFF) * 2
        If M <> 0 Then Let seed = seed Or &H80000000

        Let seed = seed And &HFFFFFFFF

        If carry Then
            Let seed = seed Xor 79764919
            Let dir = Int(seed And 255)
        End If

        Select Case dir And 130
            Case 0:   Let by = Int(by + 1) And 127
            Case 2:   Let bx = Int(bx + 1) And 127
            Case 128: Let by = Int(by - 1) And 127
            Case 130: Let bx = Int(bx - 1) And 127
        End Select
        Let Cells(by + 1, bx + 1).Interior.COLOR = COLOR(part And 3)
    Next length
Next part
Let Range("97:999,DY:ZZ").Interior.COLOR = 0
ActiveWindow.Zoom = 10
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

Pas de feedback sur ce dernier code ? (celui de mon précédent message)
Personne ne l'as testé?

(ou alors personne n'a plus le vinyle de BBH 75 ) [5]

 

[Modeste geedee]

Bonsour®

Bonjour le fil, le forum

Je suis resté bouche bée devant ce code
(et je cherche toujours à comprendre sa logique)
A tester sur un classeur vierge
(en écoutant la chanson N°3 de la face A de BBH 75)

énigmatique ...
je subodore un codage de Huffman...???

 

[Si...]

Re

Je suis resté bouche bée devant ce code (et je cherche toujours à comprendre sa logique)
Pas de feedback sur ce dernier code ? (celui de mon précédent message)
Personne ne l'as testé?]

J'ai lu puis vu ... Il y a des instructions qu'on peut supprimer sans problème (Let, Step 1…)
Il faut savoir jongler avec les opérateurs AND, OR, XOR qui agissent en mémoire sur des octets, bit par bit, dans le but d'attribuer des couleurs de fond (4) par groupe aux nombreuses cellules concernées.

Si on devait passer par les adresses de celles-ci, il faudrait de plus gros tableaux que celui utilisé (Brush).

 

[Staple1600]

Bonjour le fil, le forum

Plus de participants?
Z'êtes trop occupé à préparer vos fêtes de fin d'années?
ou pas disponible pour cause de:
1) PSG-Rennes cet aprés-midi à Rennes
2) Finale HandBall féminin demain
3) Star Wars Les Derniers Jedi

Dans ce cas je vos dérange pas plus longtemps en faisant juste ce petit up

 

[Si...]

Ce lien n'existe plus Bon_soir

Bonjour le fil, le forum
Plus de participants?
Z'êtes trop occupé à préparer vos fêtes de fin d'années?
Dans ce cas je ne vous dérange pas plus longtemps en faisant juste ce petit up

Pour te faire patienter : un MessagALaKonDiraThon
En ces temps de fin d'année, lire le courrier, préparer les cadeaux, les transporter et stocker à la maison demande beaucoup de temps. Heureusement que c'est une fliquette blonde déguisée en brune qui n'a pas réalisé que j'étais incognito donc méconnaissable et exempt de prune !