Les codes les plus funky de la planète Excel

[don_pets]

'llo everybody,

Il fut un temps pas si lointain où je découvrais avec émerveillement un post relatif aux meilleurs codes que chacun avait pu trouver, bricoler ou imaginer.

Bien sur la question n'était pas de savoir lequel était le meilleur, tout ça tout ça, mais plutôt dans l'esprit de partager un peu ses idées. J'ai trouvé cette idée brillante, en plus de codes rigolos et qui en complément d'être fun ,m'ont donnée envie d'en savoir un peu plus.

Je me disais donc qu'il était temps de relancer une pareille initiative qui dans le concept se rapproche de celui de ce fofo. Partage, bricole,entraide et Excel !

Inutile de crier au scandale si vous rencontrez ici un code, et que vous en êtes l'auteur(légitime ou pas) . Il s'agit simplement de donner, disons un top five, des macros les plus chouettes (ou fun, ou pratiques, ou qui déchirent tout) que vous avez eu l'occasion de tripatouiller.

J'espère que cela apportera un lot de belles surprises, et surtout trouvailles qui aideront certains d'entre nous !

Je prépare mon top Five.

See ya

don

 

[don_pets]

Re : Les codes les plus funky de la planète Excel

Dans un ordre quelconque voici mes 5 codes funky :

- The Voice

Dim Sp As Object
On Error Resume Next
Set Sp = CreateObject("Sapi.SpVoice")
If Sp Is Nothing Then Exit Sub
Sp.Speak "you are a quiche"

Nota Bene - J'ai toujours aimé la voix tout en douceur de Madame Excel, on peut lui faire dire n'imp ^^

- Rajout d'une donnée sur toute une colonne

Dim Data As String
Dim plage As Range
Dim cellule As Range

With Sheets("FeuilUn")
Set plage = .Range("A2:A36000" & .Cells(Application.Rows.Count, 8).End(xlUp).Row)
Data = InputBox("Qu'est-ce qu'on rajoute ma choute ?")
For Each cellule In plage
If cellule.value <> "" Then
cellule.Offset(0, 5).value = Data
End If
Next cellule

Nota Bene - J'ai trouvé ça un jour, et 'tain ce que c'est pratique quand des utilisateurs bossent sur des tcd

- L'import d'une feuille d'un fichier fermé

Dim nom$, WBKSource As Workbook
With Application.FileDialog(msoFileDialogOpen)
   .Title = "Suzanne ouvre toi"
    .Filters.Clear
    .Filters.Add "Ton Tableur", "*.xlsX*, *.Xlsm*, *.Xls*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
           Set WBKSource = Workbooks.Open(nom)
           With WBKSource
            rep = InputBox("Quelle feuille andouille ?")
                .Sheets(rep).Copy Before:=ThisWorkbook.Sheets(1)
                .Close False
            End With
        Else
        MsgBox "Boaaa t'veux rien !", , "dô_Ôb": Exit Sub
        End If
End With

Nota Bene - J'ai hésité à mettre le code dont je me sers lorsqu'il faut importer l'ensemble des documents Excel d'un rep précis, mais disons que c'est celle là que j'utilise le plus !

- Envoi d'une feuille par mail

dest = InputBox("Pour quiqui ? (Ce sera notre petit secret)")
feuil = InputBox("Hm hm et qu'envoyons-nous ?")
Sheets(feuil).Activate
Sheets(feuil).Copy
With ActiveWorkbook
    .SendMail Recipients:=dest
    Application.DisplayAlerts = False
    .Close
    Application.DisplayAlerts = True
End With

Nota Bene - Con comme là lune, mais pratique aussi ^^

- La recherche

- Sur feuille
		
Range("B10:B36000").ClearContents

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
reponse = InputBox("Tu vas te mettre à table !", "SuperRecherche")

Call SearchName(reponse)

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

	- Sur module

Sub SearchName(mot)
ligne = 10

For Each ws In Sheets
If ws.Name <> "Feuil1" Then
With ws.Cells
    Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
    
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
         Sheets("Feuil1").Cells(ligne, 2).Select
          Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
          ws.Name & "!" & c.Address, TextToDisplay:=c.Value
          'MsgBox (ws.Name & c.Address)
          ligne = ligne + 1
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
      trouve = True
    End If
End With
End If
Next ws

If Not trouve Then MsgBox ("Nan pas de " & mot & " ici, cherche et trouve aut'chose")

End Sub

Nota Bene - J'ai gardé pour la fin, celle qui m'a donné le plus de suée à l'époque où je cherchais déspeérément à coder une macro de recherche fun, et que je n'arrivais pas à transcrire ceque je voulais =__=

Voilà mon top failleveu

See ya

don

 

[Modeste geedee]

Re : Les codes les plus funky de la planète Excel

Bonsour®

- The Voice

Dim Sp As Object
On Error Resume Next
Set Sp = CreateObject("Sapi.SpVoice")
If Sp Is Nothing Then Exit Sub
Sp.Speak "you are a quiche"

Nota Bene - J'ai toujours aimé la voix tout en douceur de Madame Excel, on peut lui faire dire n'imp ^^

depuis Excel 2007 :
sans autre déclaration, on peut écrire simplement :

Application.Speech.Speak "you are a quiche"

 

[ya_v_ka]

Re : Les codes les plus funky de la planète Excel

Bonsour®

depuis Excel 2007 :
sans autre déclaration, on peut écrire simplement :

Application.Speech.Speak "you are a quiche"

Et moi qui pensait qu'il ne lui manquait que la parole !

Mais existe-t-il un "patch" pour lui donner un accent un peu plus "Frenchy" ?

Ya'v

 

[Modeste geedee]

Re : Les codes les plus funky de la planète Excel

Bonsour®



Avertissement cette application (notamment synthèse vocale) ne semble pas fonctionner correctement sous Windows 64bits
voir ce fil :
https://www.excel-downloads.com/threads/tirage-aleatoire-bingo.220496/

 

[ya_v_ka]

Re : Les codes les plus funky de la planète Excel

OK merci, mais je ne me sens pas de taille... J'attendrais XL2030, il y sera peut-être d'origine !!!

Ya'v

 

[DoubleZero]

Re : Les codes les plus funky de la planète Excel

Bonjour, le Fil , le Forum,

... donner un accent un peu plus "Frenchy"...

Une discussion récente.

A bientôt