Top 50 des macros préférées des xldiens

[Staple1600]

Suite au conseil de Darnel

J'ouvre ce fil pour que chacun l'alimente
de sa macro ses macros préférées
(qu'il utilise dans un cadre professionnel ou ludique)

Voila qu'en pensez-vous?


Ps: lors de mes périgrinations ce matin sur le web j'ai trouvé cela:
(Faut être un anglophone, mais c'est tres interessant)
(enfin moi ca m'a interessé)
String Functions for VB/VBA

[Staple1600]

macro 1/50

macro 1
Créer 12 feuilles mensuelles dans un classeur

Sub Mois12F()
'issue de VBA pour Excel (ISBN: 2-7429-6110-0)
Dim i s Integer
For i=1 to 12
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(30*i,"mmmm")
Next
For i= 1 To Worksheets.Count -12
SendKeys "{enter}
Sheets(1).Delete
Next
End sub

MACRO A TESTER SUR UN CLASSEUR VIERGE
(ne contenant aucune données)

[Staple1600]

Macro 2/50

Sub Wish_You_Were_Here()
dgs=MsgBox "Aurais-je eu une mauvaise?",vbYesNo,"Question"
if dgs <> vbYes Then Exit sub
MsgBox "C'est qu'il semblerait au vue des réponses obtenues..."
End Sub

Au plaisir de vous lire

[Staple1600]

bonjur

Personne n'a de macros favorites sur le forum?

[Hervé]

bonjour staple, le forum


un code que j'utilise souvent pour retrouver les index des colorindex :

Dim i As Byte

With Sheets.Add
    For i = 1 To 56
        .Cells(i, 1).Interior.ColorIndex = i
        .Cells(i, 2) = i
    Next i
End With

salut

[Jam]

Utile lorsqu'on a oublié le MdP d'une feuille:

'================================================
'Sub qui permets de faire sauter la protection de
'n'importe quelle feuille (auteur inconnu)
'================================================
Sub BreakPasswordSheet()

Dim i As Integer, j As Integer, k As Integer, l As Integer, M As Integer, N As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer

On Error Resume Next
     
For i = 65 To 66
    For j = 65 To 66
        For k = 65 To 66
            For l = 65 To 66
                For M = 65 To 66
                    For i1 = 65 To 66
                        For i2 = 65 To 66
                            For i3 = 65 To 66
                                For i4 = 65 To 66
                                    For i5 = 65 To 66
                                        For i6 = 65 To 66
                                            For N = 32 To 126
                                                ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(M) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(N)
                                                If ActiveSheet.ProtectContents = False Then
                                                    MsgBox "One useble password is " & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(M) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(N)
                                                    Exit Sub
                                                End If
                                            Next
                                        Next
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
Next

End Sub

A+

[nat54]

Bonjour,

Moi c'est enlever les doublons d'une liste :d

Sub ENLEVER_DOUBLONS()
ListeValUniques Range("A2:A5000"), Range("E1")   ‘ on met la liste en colonne 1, la liste épurée se colle en colonne E
End Sub

Sub ListeValUniques(PlageSrc As Range, CellDest As Range)
'Extrait les valeurs uniques d'une colonne et les renvoie
'dans une autre, à partir de CellDest
Dim Arr1, Elt, Arr2(), Coll As New Collection

If PlageSrc.Columns.Count > 1 Then Exit Sub
Arr1 = PlageSrc.Value

For Each Elt In Arr1
On Error Resume Next
Coll.Add Elt, CStr(Elt)
If Err.Number = 0 Then
ReDim Preserve Arr2(1 To Coll.Count)
Arr2(Coll.Count) = Elt
End If
On Error GoTo 0
Next

CellDest.Resize(Coll.Count).Value = _
Application.Transpose(Arr2)

End Sub

[Staple1600]

Envoyé par Jam

Utile lorsqu'on a oublié le MdP d'une feuille:

'================================================
'Sub qui permets de faire sauter la protection de
'n'importe quelle feuille (auteur inconnu)
'================================================
Sub BreakPasswordSheet()

Dim i As Integer, j As Integer, k As Integer, l As Integer, M As Integer, N As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer

On Error Resume Next
     
For i = 65 To 66
    For j = 65 To 66
        For k = 65 To 66
            For l = 65 To 66
                For M = 65 To 66
                    For i1 = 65 To 66
                        For i2 = 65 To 66
                            For i3 = 65 To 66
                                For i4 = 65 To 66
                                    For i5 = 65 To 66
                                        For i6 = 65 To 66
                                            For N = 32 To 126
                                                ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(M) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(N)
                                                If ActiveSheet.ProtectContents = False Then
                                                    MsgBox "One useble password is " & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(M) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(N)
                                                    Exit Sub
                                                End If
                                            Next
                                        Next
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
Next

End Sub

A+

Pour déprotéger mais en plus court
(Trouvé chez nos amis germains)

Sub DeprotegeFeuille()
'SOURCE
'http://www.herber.de/forum/archiv/128to132/t128552.htm
'Sub undweg()
With ActiveSheet
.Protect vbNullString, , , , True
.Range("a1").Copy .Range("a1")
.Unprotect vbNullString
End With
End Sub

Sub DeprotegeClasseur()
'Sub hinfort()
With ActiveWorkbook
.Protect vbNullString, True, True
.Unprotect vbNullString
End With
End Sub

[nat54]

On en veut encore !!

Salut le Forum

Un fichier regroupant des codes avec la méthode Intersect

Les exemples ont été faits par _Thierry

Mytå