EXCEL

Un bouton de barre d'outils pour faciliter la navigation entre les feuilles d'un classeur

RECOVER un utilitaire Microsoft pour réparer les fichiers excel endommagés (macro complémentaire)

Password Excel
Quoi de plus désagréable que de ne pouvoir modifier une feuille de calcul ou un classeur Excel parce qu'on ne se rappelle plus du mot de passe de protection que l'on avait pourtant inventé quelques jours auparavant !
Imaginez par ailleurs que vous devez accéder, dans l'urgence, au travail d'un collègue de bureau qui est parti en vacances, en retraite ou chez la concurrence !
Il existe plusieurs sortes de mot de passe sous Excel. Le mot de passe d'ouverture d'un fichier Excel, le mot de passe d'une feuille de calcul, d'un classeur ou d'une macro (VBA). Avec l'utilitaire Password Excel vous supprimerez très facilement les mots de passe de classeurs et de feuilles de calcul, mais pas ceux qui ont été définis pour protéger un fichier "VBAProject Mot de passe".
Password Excel
Ce logiciel peut être utilisé sur les versions Excel 97 et 2000 et ne pèse que 218 Ko. Alors n'hésitez pas à le stocker chez vous et à le garder précieusement. Vous serez certainement très heureux de le tester le jour où vous en aurez besoin !

PolyKromy
Ce site propose des trucs et astuces animés sur Excel, de nombreux cours avancés, une newsletter bi-hebdomadaire et des applications en VBA.

Excel-downloads www.excel-downloads.com
Voici près d'une centaine de programmes pour Excel à télécharger pour diverses utilisations: gestion, jeu, programmation, business...

Macro auto sous Excel 97
Il faut modifier le code de l'ouverture du classeur ( Worksheet_Open ) et y mettre l'appel à notre macro ou codifier les actions de la macro dedans.
Pour ce faire, clic droit sur le label de la feuille 1 ( Feuil1 par défaut ), Option "Visualiser le code", puis double clic sur ThisWorkbook à gauche puis sélectionner "Workbook" dans la fenêtre de
visualisation du code située à droite.
Et voilà, il n'y a plus qu'à coder ce que l'on veut et enregistrer le document Excel.

Créer une liste déroulante
1) Il faut créer la liste dans ta feuille excel
2) Sélectionner la cellule ou on veut qu'apparaisse la liste déroulante.
3) Aller dans Données, puis dans validation, dans l'onglet option à
autoriser à la place de Tout choisir Liste, puis dans source sélectionner la zone de liste et faire OK.
(La liste et la cellule déroulante doivent se trouver dans la même
feuille, c'est pourquoi il est important pour la présentation de mettre la liste dans un endroit isolé.

dans diverses questions ou réponses, il est souvent fait allusion au fichier perso.xls. Qui pourrait me renseigner sur ce fichier ?
c'est un fichier qui permet de créer des macros qui sont actives à chaque lancement d'excel

Macro pour mettre en surbrillance les doublons:
Private Sub Worksheet_Change(ByVal Target As Range)
'désactive l'affichage
Application.ScreenUpdating = False
If Target.Column = 1 Then 'colonne A
Target.CurrentRegion.Select
For Each c In Selection
If c = Target And c.Address <> Target.Address Then
c.Interior.ColorIndex = 6 ' colorie en jaune la précédente valeur identique
End If
Next c
End If
Target.Select
'réactive l'affichage
Application.ScreenUpdating = True
End Sub

Afficher une boite de dialogue Rechercher
Application.Dialogs(xlDialogFormulaFind).Show

J'ai un problème lorsque j'ouvre excel, il essaie d'ouvrir un fichier xxx.xla qui n'existe plus. Je voudrais enlever cette liaison avec cette macro d'ouverture, mais je ne sais pas où aller.
regarde au menu, Outils, Macro complémentaire, décoche le xla en question.

Dénombrer des cellules non vides
NBVAL compte aussi bien les vraies vides que les "fausses" cellules vides,
résultat d'une formule du style =Si(blabla;"";blabla)
Pour dénombrer en excluant les vraies/fausses vides :
=SOMMEPROD((A4:A6<>"")*1)
Une autre peut être
ND(A:A)-1 ' Pour toute une colonne
ND(A5:A15) ' Pour une partie

Compter le nombre de lignes utilisées (non vides)
Worksheets("tutu").Usedrange.Columns("D:D").select
Selection.rows.count
c'est possible de le faire sans sélectionner la colonne
NbrNonVide = Application.CountA(Columns("D"))
Sur la première ligne de la colonne testée
ND(D:D)-1
Ou sur une ligne quelconque d'une autre colonne
ND(D:D)

Obtenir la somme des 7 plus grandes valeurs sur une colonne
=SOMME(GRANDE.VALEUR(A1:A12;{1;2;3;4;5;6;7}))
Ou la formule suivante (non-matricielle):
=SOMMEPROD(GRANDE.VALEUR(A1:A12;{1;2;3;4;5;6;7}))

Coder une plage de cellules paramétrable
Range(Cells(valCol1, varLigne1),cells(varCol2,varLigne2)).value

Remplir un combobox avec 2 colonnes à partir d'un fichier texte
Private Sub UserForm_Activate()
Dim Code1,code2
Open "C:\Excel\Tarif\clients.txt" For Input As #1
Do While Not EOF(1)
Input #1, Code
With ComboBox1
Code1 = left(Code, instr(code, ","))
Code2 = Mid(Code, instr(code, ","+1))
.AddItem Code1
End With
Loop
Close #1
End Sub

Programmation VBA pour excel

Créer une page web avec la feuille active
Attribute VB_Name = "CreerPageWeb"
Sub PublishObjectExample()
Dim oPO As PublishObject
'Set a reference to the Publish object
Set oPO = ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
"C:\My Documents\LABRCR\ExcelData\Page.htm", "District A", "", xlHtmlCalc)
'Publish it (Save it as HTML)
oPO.Publish True
'Display the unique identifier number
'This will be different each time this code is run.
MsgBox oPO.DivID
End Sub

Afficher un popup
Attribute VB_Name = "MsgPopup"
Sub MessagePopUp()
Set oSH = CreateObject("WScript.Shell")
Const nSecToWait = 3
Const typButtonless = 7 '&HB ' undoc constant
Dim sMsg
sMsg = vbLf & "Ce message SANS BOUTON" & vbCrLf & vbCrLf _
& "va se fermer dans : " & CStr(nSecToWait) & " secs... "
' display popup with NO button (only on Win9X/ME)...
oSH.Popup sMsg, nSecToWait, "Popup Sans Bouton", typButtonless
End Sub

Un petit simulateur de vol dans Excel 97
1. Lancez Excel 97.
2. Appuyez sur F5.
3. Dans la zone référence, mettez X97:L97, cliquez sur OK.
4. Appuyez sur la touche "Tabulation", normalement, on se retrouve en M97.
5. Gardez appuyées les touches "CTRL" et "SHIFT" puis cliquez sur l'icône assistant graphes (c'est une icône avec un graphique en barres).
Le petit simulateur fonctionne avec la souris et les boutons gauche/droite pour marche avant/arrière.

Un site avec plein d'infos sur le VBA

Cours de formation excel

http://xlbysteph.free.fr/aideinformatique/actionvba
http://cherbe.free.fr/xl_debutant1999.htm
http://intendant.free.fr/vba.htm
http://jacxl.free.fr/cours_xl/cadres.html
http://www.polykromy.com/html/astuces.html

Selectionner la dernière cellule en bas a droite du tableau:
Range("a1").End(xlDown).End(xlToRight).Select
ou
Cells(Cells.Count).Select

Comment empecher de saisir dans des cellules tant qu'une cellule principale n'est pas renseignée?
A copier dans le module de la feuille concernée
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not IsNull(Intersect(Range("e17:e32"), Target)) Then _
If Range("a1") = "" Then Range("a1").Select
End Sub

Comment supprimer des liaisons obsolètes?
Edition / Liaisons / Modifier la source et dans la liste qui apparaît,
choisir le classeur dans lequel on veut supprimer la liaison.

Pour imprimer une feuille masquée
Sub Impression_masquée()
Application.ScreenUpdating = False
Sheets("Facture").Visible = True
' -------------------------------------------
'actions sur la feuille

' ------------------------------------------
' ATTENTION : pour masquer une feuille il faut que
' le classeur en comporte au moins 2
Sheets("Facture").Visible = False
Sheets("Feuill_base").Select
Application.ScreenUpdating = True
End Sub

Je cherche une fonction qui m'informerait si les caractères dans une
autre cellule sont en GRAS
Function isgras(cellule) As Boolean
Application.Volatile True
isgras = cellule.Font.Bold
End Function
ou
Function GRAS(Adresse As Range) As Boolean
GRAS = Adresse.Font.Bold
End Function
ou
Function FormatGras(MaPlage As Range)
Application.Volatile
If MaPlage.Font.Bold = True Then
FormatGras = True
else
FormatGras = False
End If
End Function

progressbar
Public I_progression
sub lirefichier()
S_FichierLire = "chemin:\le nom de ton fichier"
I_NoFichier = FreeFile()
Open S_FichierLire For Input As #I_NoFichier
Taillefichier= LOF(I_NoFichier) 'Lit la taille du fichier
TailleLue=0
Do While Not EOF(I_NoFichier)
' La boucle est effectuée jusqu'à la fin du fichier.
Input #I_NoFichier, S_Donnéeslues
' Place les données lues dans la variable.
TailleLue=taillelue+len(S_Donnéeslues)
I_Progression = TailleLue/ TailleFichier
' ici tu obtiens un pourcentage
Application statusbar="déja "& format(I_progression,"0%")
Call LaRoutineProgressBar (i_progression)
'à toi de l'adapter à la variable du ProgressBar
' Là tu met tu met ton code de traitement de tes
données
'--------
'--------
Loop
End Sub

supprimer des lignes
Sub suplignes()
'désactiver l'affichage
Application.ScreenUpdating = False
Application.Goto Reference:="R1C1"
For a = 600 To 1 Step -1
If Cells(a, 1).Value = False Then
Cells(a, 1).EntireRow.Delete
End If
Next a
'réactiver l'affichage
Application.ScreenUpdating = True
End Sub

pour masquer une feuille
Menu -> Format -> Feuille -> Masquer
En revanche il en faut au moins une visible.

Sur une feuille Excel de la cellule A4 à A420 j'ai une série de code.
J'aimerai qu'en tapant un code dans la cellule A1 par exemple, la ligne
correspondante soit trouvée, et que mon curseur de saisie se positionne sur
cette ligne dans la colonne F.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("a1").Address Then
Cells.Find(What:=Range("a1").Value, After:=ActiveCell,
LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False) _
.Activate
End If
End Sub
autre
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule As Range
If Target.Address = "$A$1" Then
For Each Cellule In Range("A4:A420")
If Target = Cellule Then
Cells(Cellule.Row, 6).Select
End
End If
Next Cellule
End If
End Sub

savoir la ligne du dernier enregistrement (de la colonne A par exemple)...
Pour le moment je me débrouille avec une macro du style :
With Sheets("Listing CES brut").Range("A1:A5000")
Set c = .Find("", LookIn:=xlFormulas)
If Not c Is Nothing Then
firstaddress = c.Address
ligne = Right(firstaddress, Len(firstaddress) - 3)
End If
End With
réponse:
ligne = range("a65536").end(xlup).row

Pour trouver la dernière cellule tu peux utiliser le code suivant
v_derniereligne=Columns("A:A").Find("*", , , , , xlPrevious).Row

Cette formule va te renvoyer le numéro de la dernière ligne de la colonne A
Sub Roxane_modif()
For Each cell In ActiveSheet.UsedRange
If Not IsEmpty(cell) Then
cell.Select
'On explore chaque caractère un par un
For i = 1 To Len(cell.Value)
'On garde une trace de l'ancienne couleur de caractère
a = cell.Characters(i, 1).Font.Color
'On colorie en rouge le caractère courant...pour ne pas se perdre...
cell.Characters(i, 1).Font.Color = 255
MsgBox cell.Characters(i, 1).Font.Name
cell.Characters(i, 1).Font.Color = a
Next i
End If
Next
MsgBox "Y'en à plus..."
End Sub
ou
Tu as la fonction de feuille (a adapter) :
LIGNES(A1:C4) égale 4
et la fonction VBA :
Selection.Rows.Count ' ( Exemple)

J'ai une formule trop longue pour l'écrire dans la barre de formule, comment faire?
Tu ne peux pas passer outre la limite de caractères pour une formule.
Le contournement est de décomposer ta formule en utilisant la fonction
Indirect par exemple.
Exemple :
1/placer en A1 un texte correcpondant à une référence longue
2/remplacer dans la formule, la référence longue par : Indirect(A1)

Une sub ou une function peuvent recevoir plusieurs arguments.
Private Sub CommandButton1_Click()
Call SubEssai("Test", " encore", " réussi") 'Si Call utilisé, arguments entre parenthèses
ou :
SubEssai "Test", " encore", " réussi" 'sans les parenthèses
End Sub
Sub SubEssai(arg1 As String, Arg2 As String, Arg3 As String)
MsgBox arg1 & Arg2 & Arg3
End Sub
La différence entre Sub et Function est que tu ne doit pas mettre le signe "="
quand tu appelle une Sub.

la recherche sur une sous-partie d'un texte d'une cellule
Tu peux l'utiliser avec la fonction RECHERCHEV de la manière suivante :
=RECHERCHEV("*"&D5&"*",F5:F8,1,0)
Avec en D5 ton nom à chercher et en F5:F8 ta liste.
Pour une recherche insensible à la casse, vaut mieux:
=NB.SI($C$2:$C$20;"*"&A2&"*")>0
Complément pour éviter qques désagréments
Exemple :
Dans la liste des noms MARTIN
Dans la liste des prénoms/noms : Robert MARTINEAU ou Marcel MARTINE
Les solutions précédentes vont renvoyer VRAI car la chaîne MARTIN est
trouvée !
Une solution pour contourner (mêmes plage que dans le 1° exemple) :
Formule du format conditionnel :
=NON(ET(ESTERREUR(TROUVE(A2&"$¤£";$C$2:$C$20&"$¤£"))))
il va falloir utiliser plusieurs fonctions :
hypothèse de base : texte est la cellule contenant prénom.nom
1 - fonction CHERCHE qui va te permettre de savoir où se
trouve le nom dans ta cellule prénom.nom
ex : le nom est séparé par un espace
= cherche ( " "; texte )
2 - fonction NBCAR qui va te permettre de savoir combien
de caractère possède la cellule nom.prénom
ex : = nbcar ( texte )
3 - fonction DROITE qui va te permettre d'extraire les
caractères situés sur la droite de la cellule nom.prénom
ex : =droite ( texte ; nbcar(texte)-cherche(" ";texte) )
Voila on connaît maintenant le nom de ta cellule prénom.nom
tu n'as plus qu'à comparer les deux.

Controle de saisie: limiter le nombre de caractères a 3
Donnée validation autoriser personnalisé
la formule est =et(esttexte(a1);nbcar(a1)<4)
Méthode simple:
Tu sélectionnes les cellules, puis menu Données/Validation/longueur du
texte; minimum 1; maximum 3

J'ai cree un userform dans lequel j'ai des textbox dont les valeurs (prix en
$) sont recherchees dans une matrice lies par des listebox.
Malheureusement lorsque les donnees se collent sur la feuille, Excel ne
reconnait pas les data comme des nombres. Je doit a chaque fois cliquer
l'option convertir en nombre pour ensuite pouvoir imposer le format $ ##.00.
J'ai essaye de changer mon format de textbox sans aucun resultats
convainquants...
la difficulté peut provenir :
A ) Séparateur décimal.
Quand tu tapes une données dans un textbox, comme le contenu de ce textbox est toujours du "TEXTE", ce dernier accepte le point ou la virgule comme séparateur décimal malgré "le vrai séparateur décimal" défini dans le panneau de configuration.
A )
Pour chacun de tes textbox de ton formulaire , tu peux ajouter ceci :
Cela t'assure de toujours avoir dans le textbox, le bon séparateur décimal.
------------------------
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 44 Or KeyAscii = 46 Then
KeyAscii = Asc(Application.International(xlDecimalSeparator))
End If
End Sub
Pour afficher un format particulier dans le textbox :
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox2) = True Then
Me.TextBox2 = Format(Me.TextBox2, "# ##0.00 $")
End If
End Sub
Pour transférer le contenu d'un textbox vers une cellule :
En prenant pour acquis que dans le textbox, on a le bon
séparteur décimal du système... sinon il faut faire la substitution
avant la petite procédure... sinon ça va planter !
With Worksheets("Feuil1")
.range("A1").Numberformat = "# ##0.00 $"
.range("A1") = cdbl(textbox2.value)
End with
Sinon on devra utiliser ce qui suit :
Dim A As String, B As String
A = Application.International(xlDecimalSeparator)
B = Me.TextBox2
B = Application.WorksheetFunction.Substitute(B, ".", A)
B = Application.WorksheetFunction.Substitute(B, ",", A)
With Worksheets("Feuil1")
.Range("A1").NumberFormat = "# ##0.00 $"
.Range("A1") = CDbl(B)
End With

Mettre la date de dernière modification
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Range("A1") = Now
End Sub

Créer un userform en plein écran
Application.DisplayFullScreen = True
Load UserForm1
x = Application.UsableWidth
y = Application.UsableHeight
UserForm1.Top = 0
UserForm1.Left = 0
UserForm1.Width = x
UserForm1.Height = y
UserForm1.Show
ou
Dans le module de ton UserForm, place en tête de ton module les déclarations
suivantes:
Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As
String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long,
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long,
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Ensuite la procédure évènementielle (n'oublie sutout pas d'inclure un bouton
pour fermer l'UserForm car dans ce cas, tu n'auras même plus la barre de
titre de l'UserForm !) :
Private Sub UserForm_Initialize()
Dim hWnd As Long, exLong As Long, zFactor As Integer
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then SetWindowLongA hWnd, -16, exLong And
&HFF77FFFF
zFactor = 100 * CInt(Application.Width / Me.Width)
If zFactor > 400 Then zFactor = 400
MsgBox zFactor
Me.Width = Application.Width
Me.Height = Application.Height
Me.Zoom = zFactor
End Sub

Mettre un lien hypertexte
Sub Macro4()
ActiveWorkbook.FollowHyperlink Address:="http://intendant.free.fr/liens.htm"
End Sub

2 tableaux l'un L1C2:L11C1 contient nom et a droite un montant
l'autre L14C1:L17C1 nom a droite la somme des éléments de tableau1
correspondant au nom
Sub total()
For t = 0 To 3
For t1 = 0 To 10
If Cells(2 + t1, 1).Value = Cells(14 + t, 1).Value Then
Cells(14 + t, 2).Value = Cells(14 + t, 2).Value + Cells(2 + t1, 2).Value
End If
Next t1
Next t
End Sub
Méthode 2
Sub zzz()
[B14:B17] = "=SUMPRODUCT(($A$2:$A$11=A15)*$B$2:$B$11)"
[B14:B17] = [B14:B17].Value
End Sub

Voici des exemples de userform
http://disciplus.simplex.free.fr/xl/userforms.htm#demomisange
http://ericrenaud.free.fr/dlg.htm

inscrire la valeur d'un textbox dans une cellule
La valeur de ton textbox est inscrite dans la cellule à fur et à mesure.
Private Sub TextBox1_Change()
[B1].Value = TextBox1.Value
End Sub

Comment souver les feuilles d'un classeur en plusieurs classeurs d'une feuille?
Sub EclaterClasseur()
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets
Feuille.Copy
ActiveWorkbook.SaveAs Feuille.Name
ActiveWorkbook.Close
Next Feuille
End Sub

Les erreurs de type X

Nettoyer un classeur et redéfinir le used range

Pour accéder à l'environnement VBA
Il faut appuyer sur les combinaison de touches Alt+F11

Calculer le numéro de la semaine pour une date donnée:
Public Function NoSem(UneDate As Date) As Integer
On Error Resume Next
NoSem = CInt(Format(UneDate, "ww", vbMonday, vbFirstFourDays))
End Function
Par formule , avec la date en A1:
'version français
="semaine: "&ENT((A1-(DATE(ANNEE(A1-JOURSEM(A1-1)+4);1;3)-
JOURSEM(DATE(ANNEE(A1-JOURSEM(A1-1)+4);1;3)))+5)/7)
'version anglais:
=INT((A1-(DATE(YEAR(A1-WEEKDAY(A1-1)+4),1,3)-WEEKDAY(DATE(YEAR(A1-WEEKDAY(A1
-1)+4),1,3)))+5)/7)
Par VBA:
Function ISOWeekNum(d1 As Date) As Integer
Dim d2 As Long
d2 = DateSerial(Year(d1 - WeekDay(d1 - 1) + 4), 1, 3)
ISOWeekNum = Int((d1 - d2 + WeekDay(d2) + 5) / 7)
End Function
Exemple: La date est saisie dans textbox1, on affiche la semaine dans label1 et la date complète dans label2
Private Sub textbox1_change()
Dim unedate As Date
On Error Resume Next
unedate = TextBox1.Text
If TextBox1.TextLength = 8 Then
Label2.Caption = unedate
NoSem = ISOWeekNum(unedate)
Label1.Caption = NoSem
End If
End Sub
Function ISOWeekNum(d1 As Date) As Integer
Dim d2 As Long
d2 = DateSerial(Year(d1 - Weekday(d1 - 1) + 4), 1, 3)
ISOWeekNum = Int((d1 - d2 + Weekday(d2) + 5) / 7)
End Function

Créer un combobox de couleurs à partir d'un tableau d'une feuille
Les listes sont définies dans le userform par leur nom entré à l'aide de insertion/nom/définir avec les formules suivantes dans la feuille feuil1
couleurs =DECALER(Feuil1!$A$2;;;NBVAL(Feuil1!$A:$A)-1;)
Dans le code du userform mettre
Private Sub UserForm_Initialize()
'vérifie que le classeur Démo est le classeur actif sinon l'initialisation échoue
Workbooks("Démo.xls").Activate
'remplit le Combobox
Combobox1.RowSource = "Feuil1!couleurs"
Combobox1.ListIndex = -1
End Sub

Lecture de répertoire de fichiers
Sub RecupNomFichier()
Dim Fichier As String
Dim Compteur As Integer
Dim Tableau() As String
Dim Chemin As String
On Error Resume Next
Chemin = Application.InputBox(Prompt _
:="Quel répertoire voulez-vous imprimer?")
Chemin = Chemin & "\*.*"
Range("B1") = Chemin
Compteur = 1
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
ReDim Preserve Tableau(1 To Compteur)
Tableau(Compteur) = Fichier
Compteur = Compteur + 1
Fichier = Dir()
Loop
ActiveSheet.Range("B2:B" & UBound(Tableau) + 1) _
= Application.WorksheetFunction.Transpose(Tableau)
End Sub
Sub ChercheFichier()
Dim Fs As FileSearch
Dim I As Integer
Set Fs = Application.FileSearch
With Fs
.LookIn = "C:"
.Filename = "*.pdf"
If .Execute > 0 Then
MsgBox .FoundFiles.Count & " Fichier(s) ont été trouvés."
For I = 1 To .FoundFiles.Count
ActiveSheet.Cells(I, 3) = .FoundFiles(I)
Next I
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
Set Fs = Nothing
End Sub

une macro comme celle ci-dessous qui élimine toutes les zones de texte
présentes sur une feuille.
Sub SupprimerZonesTexte()
For Each sh In ThisWorkbook.Sheets("Feuil1").Shapes
If sh.Type = 17 Then sh.Delete
Next sh
End Sub

Mettre un texte en gras
Sub MettreEnGras()
Dim Cellule As Range
For Each Cellule In Range("B1", Range("B65536").End(xlUp))
With Cellule
If .Offset(0, -1).Value <> "" Or _
.Offset(0, 1).Value <> "" Or _
.Offset(0, 2).Value <> "" Then
Cellule.Font.Bold = True
End If
End With
Next Cellule
Set Cellule = Nothing
End Sub

Plage de cellules dont on ne connait pas le nombre de lignes utilisées
Exemple: soit une plage B1:B10 qui pourrait a la prochaine execution B1:B30
Range("B1:B" & Sheets("Feuil1").Range("B65536").End(xlUp).Row)

Lecture d'un fichier texte
Sub OpenTXT(FileName$)
'ouvre un fichier texte (ou csv)
'Notez que: l'instruction 'magique' est TextToColumns.
'opentxt lit entièrement le fichier et le place dans un nouveau classeur.
'les données séparées par des ; sont mises en colones.
'le nouveau classeur porte le nom du fichier et l'onglet le nom sans .txt
Dim wb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
On Error GoTo GE
Set wb = .Workbooks.Open(FileName)
wb.Sheets(1).Columns(1).TextToColumns Range("A1"), , , False, , True
On Error GoTo 0
.DisplayAlerts = True
.ScreenUpdating = True
End With
Exit Sub
GE:
'Le fichier est introuvable
End Sub
Sub Test()
OpenTXT ("f:\excel\test.txt")
End Sub
On peut aussi utiliser
Workbooks.Open nomfichier, ReadOnly:=xlReadOnly, Format:=4

Comment peut-on exécuter automatiquement une macro au démarrage ou à
ouverture d'une feuille Excel ?
Si tu veux que ta macro s'exécute à l'ouverture de ton classeur, à mettre
dans le module "ThisWorkbook" :
Private Sub Workbook_Open()
Ici ton code...
End Sub
Si tu veux quelle s'exécute à l'activation d'une feuille, à mettre dans le
module de la feuille :
Private Sub Worksheet_Activate()
Ici ton code...
End Sub
Aussi tu peux créer une macro qui s'appelle AUTO OPEN

Afficher un label sur une courbe
Sub test()
e = 0
With ActiveChart.SeriesCollection(1)
.ApplyDataLabels ShowValue:=True
For i = 1 To .Points.Count
If (.Points(i).DataLabel.Text) * 1 > e Then
e = (.Points(i).DataLabel.Text) * 1
j = i
End If
Next
.DataLabels.Delete
.Points(j).ApplyDataLabels ShowValue:=True
End With
End Sub

pour concatener deux solutions :
CONCATENER ou &
=CONCATENER(C1;" ";G1)
= C1 & " " & G1
On ajoute " " ou & " " & pour obtenir un espace, sinon tes valeurs seront
collées

Trouver le 2e mot d'un texte en A1
=DROITE(A1;NBCAR(A1)-TROUVE(" ";A1))

Utiliser la fonction REDIM pour dimensionner dynamiquement ton tableau, voici
un petit exemple sur cette fonction :
Sub DimensionnerUnTableau()
Dim toto() As String
ReDim toto(5)
For a = 1 To 5
toto(a) = a
Next
For x = 1 To 5
msg = msg & "toto(" & x & ")" & "= " & toto(x) & vbCrLf
Next
MsgBox msg
ReDim Preserve toto(10)
For a = 6 To 10
toto(a) = a
Next
msg = ""
For x = 1 To 10
msg = msg & "toto(" & x & ")" & "= " & toto(x) & vbCrLf
Next
MsgBox msg
End Sub

Voici de bon exercisses sur les manipulations d'images
http://jacxl.free.fr/cours_xl/cours_xl_jac.html#images_api

Imprimer dans un fichier PDF
Pour convertir une feuille excel en fichier pdf, il faut avoir au préalable installé un driver qui ajoute une imprimante dédiée a cette tache.
Voir:
Sowedoo Easy PDF Converter
ou
win2pdf sur télécharger.com.
Essayez la macro suivante qui vous permet de choisir l'imprimante qui permettra de créer le PDF...
Sub Print_recap_messieurs()
Dim DefPrt ' ---- éventuellement déclarer la variable DefPrt en public
Dim rep
'----- memorisation imprimante active
DefPrt = Application.ActivePrinter
' rep = MsgBox(Application.ActivePrinter, vbInformation, "Avant")
' ------ dialogue pour changer l'imprimante
Application.Dialogs(xlDialogPrinterSetup).Show
' rep = MsgBox(Application.ActivePrinter, vbInformation, "A partir de Maintenant")
'______________
' ici la partie de code qui doit utiliser l'imprimante choisie
'--------------------------
Sheets("Feuilleàimprimer").Select
Msg = " La page est correcte, je peux imprimer ?"
Response = MsgBox(Msg, vbOKCancel)
If Response = vbCancel Then
GoTo sortie:
Else
' impression
With ActiveSheet
.PrintOut
.PageSetup.PrintArea = False
.DisplayPageBreaks = False
End With
sortie:
'----- reaffectation de l'imprimante d'origine
Application.ActivePrinter = DefPrt
' rep = MsgBox(Application.ActivePrinter, vbInformation, "Comme au
début")
End If
End Sub

Copier une plage de cellules
Sheets("Feuil1").Range("C6:C8").Value = _
Sheets("Feuil2").Range("A1:A3").Value

Comment mettre une image dans un commentaire
selectionner la cellule ou il y a le commentaire clic droit > modifier le commentaire
puis clic gauche sur la bordure du commentaires (sur la bordure, pas pour le
texte !! )
puis clic droit > format de commentaires choisir l'onglet "Couleurs et traits" et regarder dans Remplissage couleur, la, il y a "Motifs et texture" et enfin l'onglet IMAGE

Peut on écrire dans un classeur fermé?
Sub EcritDatas()
Dim Fich$, cell As Range
'nom et chemin du classeur fermé
Fich = "d:\TestAdo.xls" 'à adapter
'écrit dans le classeur fermé la valeur des cellules A1:A5
'du classeur actif
For Each cell In ActiveWorkbook.Sheets("Feuil1").Range("A1:A5")
SetExternalDatas Fich, "Feuil1", cell.Address(0, 0), cell.Text
Next
'écrit en A6 la date et l'heure de l'opération
SetExternalDatas Fich, "Feuil1", "A6", "mise à jour du " & Now
'on regarde le résultat
DoEvents
Workbooks.Open Fich
End Sub
'écrit DataToWrite dans la cellule DestCellAdr de la feuille DestFeuille du classeur fermé DestFile
Sub SetExternalDatas(DestFile As String, _
DestFeuille As String, _
DestCellAdr As String, _
DataToWrite As Variant)
Dim oConn 'As ADODB.Connection
Dim oCmd 'As ADODB.Command
Dim oRS 'As ADODB.Recordset
Dim RangeDest
'd'après Rob Bovey, mpep
' Open a connection to the Excel spreadsheet
Set oConn = CreateObject("ADODB.Connection") 'New ADODB.Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DestFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
' Create a command object and set its ActiveConnection
Set oCmd = CreateObject("ADODB.Command") 'New ADODB.Command
oCmd.ActiveConnection = oConn
' This SQL statement selects a cell range in the "feuilleTest" worksheet.
'1 Sélection pour écrire dans une seule cellule
RangeDest = DestCellAdr & ":" & DestCellAdr
oCmd.CommandText = "SELECT * from `" & DestFeuille & "$" & RangeDest & "`"
' Open a recordset containing the worksheet data.
Set oRS = CreateObject("ADODB.Recordset") 'New ADODB.Recordset
oRS.Open oCmd, , 1, 3 'adOpenKeyset, adLockOptimistic
' met a jour la dernière ligne
oRS(0).Value = DataToWrite
oRS.Update
'ferme la connection
oConn.Close
Set oConn = Nothing
Set oCmd = Nothing
Set oRS = Nothing
End Sub

Pour sélectionner une cellule
B3 Range("B3").Select
ou bien
[B3].select

Pour exécuter une macro XL4 avec VBA:
Sub AppelDeMacroXL4()
Application.Run Macro:=Range("nomDuFichier.XLS!NomDeLaMacro")
End Sub

Ouvrir successivement plusieurs fichiers protégés à l'ouverture par des mots de passe.
Il suffit de mettre Password:="mot_de_passe" après le nom du fichier à ouvrir.

Voici la liste des sites dédiés à Excel, réalisés amateurs et que nous devons tous avoir dans nos favoris.
Débutant ou utilisateur confirmé, tu y trouveras de quoi apprendre, progresser et résoudre bien des problèmes.
http://dj.joss.free.fr/faq.htm

Tester si un fichier est présent, (ou une disquette)
Sub Macro1()
On Error GoTo fin:
Workbooks.Open FileName:="a:\conbac_p.TXT"
If Err.Number = Empty Then Exit Sub
fin:
MsgBox " no. d'erreur " & Err.Number
End Sub
Un autre exemple
Sub test_disquette()
On Error Resume Next
Dim fs, d, dc, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.DriveLetter = "A" Then
n = d.VolumeName & FormatNumber(d.FreeSpace / 1024, 0) & "
KOctets libres"
If n = "" Then
MsgBox "i clic sur ok, i met n'disquette et i r'clic sur
l'macro"
Exit For
Else
n = d.VolumeName & FormatNumber(d.FreeSpace / 1024, 0) & "
KOctets libres"
MsgBox n
End If
End If
Next
End Sub
Un autre exemple pour excel97
' référencer Microsoft Scripting Runtime
Sub test_disquette()
On Error Resume Next
Dim fs, d, dc, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.DriveLetter = "A" Then
n = d.VolumeName & d.FreeSpace
If n = "" Then
MsgBox "i clic sur ok, i met n'disquette et i r'clic sur l'macro"
Exit For
Else
n = d.VolumeName & d.FreeSpace
MsgBox n
End If
End If
Next
End Sub

Si on a perdu des barres d'outil dans excel et qu'on n'arrive pas a les faire réapparaitre, voici une solution.
ouvre visual basic (Alt + F11)
Coller le code suivant dans un module sous l'arborescence du classeur actif, et l'exécuter
Sub AfficherTout()
For Each cb In Application.CommandBars
If cb.Enabled = False Then cb.Enabled = True
Next cb
End Sub

Une macro complémentaire Française contient toutes les fonctions en Français, et est capable d'interpréter le nom des fonctions anglaises, par contre une version Anglaise ne connait pas le nom des fonctions dans les autres langues.
C'est pourquoi si on ouvre un classeur Anglais sur une version Française on ne rencontre pas de problème. L'inverse n'est pas vrai.
Cette logique est toujours valable si on utilise les packs de langue d'office 2000 ou XP.
les MLP (Multi language pack) n'installent pas de complément, donc ne modifie pas cette logique.
La solution serait d'utiliser les noms anglais avec une version Française.
Voici un article technique donnant toutes les traductions :
NB: toutes les fonctions par défaut d'Excel (ex: SI(), Somme() ...) sont compatibles entre toutes les langues.

Voici une procédure qui supprime le code VBA sans afficher la fenêtre VBE.
La bibliothèque suivante doit être chargé :
"Microsoft Visual Basic for Applications Extensibility 5.3"
Sub SupprimeToutCodeEtFormulaire()
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, _
vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
End Sub
Autre solution:
Sub SupprToutCodeVBA()
'L Longre, mpfe
Dim VBC As Object
With ActiveWorkbook.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
Else: .VBComponents.Remove VBC
End If
Next VBC
End With
MsgBox "Modules et macros du classeur actif supprimées.", _
vbInformation
End Sub

Générer un saut de ligne
Dans une cellule Excel : ="Tata"&CHR(10)&"Toto" sans oublier de renvoyer à la ligne dans Format de celle >> Alignement.
Ou bien en VBA : & vblf& au lieu de & CHR(10) &

Zoom sur une plage de cellules
Voici ce que nous essayons de faire :

Bien sûr dans l'image que vous voyez ici, vous ne pouvez constater que la cellule zoomée reflète toujours le contenu de la cellule d'origine.
Dans notre exemple la cellule de total contient une fonction somme.
Pour arriver à cette solution, il faut d'abord ajouter un bouton à une barre d'outils quelconque (Standard par ex.) :
Outils/Personnaliser
Dans l'onglet Commandes, sélectionnez la Catégories Outils.
Glissez la commande Photo sur la barre d'outils Standard.
Cliquez sur le bouton Fermer.
Maintenant il nous faut utiliser ce bouton Photo :
Sélectionnez la plage à zoomer.
Cliquez sur le bouton Photo
Dessinez un rectangle sur votre feuille, vous pouvez le dessiner sur une autre feuille de calcul ou sur une feuille graphique (cliquez sur l'onglet correspondant puis dessinez).
Agrandissez la photo de la cellule à la taille désirée, elle se manie comme une image. Les 2 traits qui relient la photo à la cellule d'origine sont tout simplement 2 lignes dessinées avec l'outil Trait de la barre d'outils Dessin.
Vous pouvez constater que cette image est liée à la plage d'origine :
Changez une des valeurs A, B, C ou D, le total change et la photo également.
(Vu sur le site Cathy Astuces)

Lorsque je ferme un fichier avec un filtre actif, la réouverture est très longue.
Il faut enlever le filtre à la fermeture
Sur le Workbook_BeforeClose mettre
Worksheets("Sheet1").AutoFilterMode = False

sauriez vous comment extraire le nom d'une feuille excel
pour le récupérer automatiquement dans une cellule?
Une...
(Le fichier doit être déjà enregistré)
=STXT(CELLULE("filename");TROUVE("]";CELLULE("filename"))+1;99)
Dans le cas où tu aurrais une date comme nom de feuille, tu peux utiliser la formule suivante :
=SUBSTITUE(STXT(CELLULE("nomfichier";A1);TROUVE("]";CELLULE("nomfichier";A1))+1;999);".";"/")*1
'donne le nom de la feuille ou ce trouve maCel
Function SheetName3(ByRef maCel As Range) As String
Application.Volatile
SheetName3 = maCel.Parent.Name
End Function
Dans le même style en plus court
Function NomF()
Application.Volatile
NomF = ActiveSheet.Name
End Function

Un timer
Declare Function GetTickCount Lib "Kernel32" () As Long
Sub test()
For i = 1 To 50 Step 1
Minuterie 200
ActiveSheet.Shapes("essai").Select
Selection.ShapeRange.IncrementTop -0.75
Next i
End Sub
Sub Minuterie(Milliseconde As Long)
Dim Arret As Long
Arret = GetTickCount() + Milliseconde
Do While GetTickCount() < Arret
DoEvents
Loop
End Sub
Un autre timer
Il faut utiliser la méthode OnTime.
Exemple :
Sub ALuumer()
MsgBox "Il faut attendre"
Application.OnTime Now +
TimeValue("00:00:15"), "Eteindre"
End Sub
Sub Eteindre()
MsgBox "15 secondes ce sont écoulées"
End Sub
Cordialement
Cette fonction est aussi interressante
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Tempo()
MsgBox "Msg 1"
Sleep (1000) ' pause de 1 seconde
MsgBox "Msg 2"
Sleep (3000) ' pause de 3 seconde
MsgBox "Msg 3"
End Sub

Pour naviguer entre les onglets
Ctrl + Page Up
Ctrl + Page Down

Créer un fichier texte et l'ouvrir avec le notepad
Sub LaMacro()
Open "c:\Toto.txt" For Output As #1
Print #1, "Je suis un bout de texte"
Close #1
x = Shell("c:\winnt\system32\notepad.exe c:\Toto.txt", vbNormalFocus)
End Sub

Exemple d'utilisation de statusbar
Sub StatusBarTest()
Application.ScreenUpdating = False
SBText = "Traitement en cours"
For t = 1 To 40
'mettre un timer ou un traitement ici
SBText = SBText & Chr(1)
Application.StatusBar = SBText
End If
Next t
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Comment selectionner toutes les lignes d'une feuille
Rows("1:" & Cells.SpecialCells(xlCellTypeLastCell).Row).Select

Voila une barre de progression.(Je sais c'est un peu long comme code mais il
faut ce qu'il faut)
Ajouter un Userform(UserForm1), 2 Labels(Label1 et Label2) et exécuter la proc EssaiProgress ci-dessous pour voir le résultat.
Attention pour le titre de la form(Caption) le paramétrer dans les propriétés et non dans la proc Initialize de ta form sinon on vera la croix.
A mettre dans un module standard.
Public Iteration As Single
Public Increment As Single
Public Sub ProgressBarContinue(Maximum As Long)
'ne pas oublier de remettre les variables à zéro dans la procédure d'appel "Iteration = 0" "Increment = 0" pour éviter dans un 2ème appel que la progression en % soit érronée
Dim Frm As UserForm
On Error Resume Next
Set Frm = UserForm1
'divise la largeur maxi (300) du controle par le nombre maximum d'appel de la procédure
If Iteration = 0 Then
Iteration = 300 / Maximum
End If
'incrémente à chaque appel pour augmenter la largeur du controle
Increment = Increment + Iteration
'permet la mise à jour de la Form
DoEvents
'change la largeur du controle
Frm.Label1.Width = Increment
'affiche le pourcentage de progression
Frm.Label2.Caption = Round(Increment / 3, 0) & " %"
'déplace le controle pour qu'il soit
'centré sur la barre de déffilement
If Increment < 30 Then
Frm.Label2.Left = 0
Else
Frm.Label2.Left = (Increment / 2) - 15 '(-15 = moitié de la largeur du
controle LblTexte)
End If
Set Frm = Nothing
End Sub
A mettre aussi dans le module standard et à exécuter pour l'éssai.
Sub EssaiProgress()
Dim I As Integer
Dim J As Integer
UserForm1.Show False
For I = 1 To 200
For J = 1 To 200
Cells(I, J).Value = I + J
Next
ProgressBarContinue 200
Next
Iteration = 0
Increment = 0
Unload UserForm1
End Sub
A mettre dans le module de la Form(Les API enlèvent la croix, pour un ProgressBar c'est mieux)
'Recup du handle
Private Declare Function RecupFenetre Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
'récup du style
Private Declare Function RecupStyleFenetre Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'défini le nouveau style
Private Declare Function DefStyleFenetre Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong
As Long) As Long
Const GSTYLE = -16
Const SYSMENU = &H80000
Private Sub UserForm_Initialize()
Dim Identifiant As Long
Dim Style As Long
Identifiant = RecupFenetre("thunderdframe", Me.Caption)
Style = RecupStyleFenetre(Identifiant, GSTYLE)
Style = (Style And Not SYSMENU)
DefStyleFenetre Identifiant, GSTYLE, Style
With Me
.Height = 35.25
.Width = 300
End With
With Me.Label1
.Top = 0
.Left = 0
.Width = 0
.Height = 16
.BackColor = &H800000 'bleu foncé
End With
With Me.Label2
.Top = 0
.Width = 0
.Width = 30
.Height = 10.05
.ForeColor = &H8000000E 'blanc
.BackStyle = fmBackStyleTransparent
End With
End Sub 'proposé par Hervé liste microsoft.public.fr.excel

Modifier l'icone et le texte dans le barre de titre d'excel?
'this code sets the main Excel icon to the .ico file supplied
'(The Declares lines are one line each)
'Stephen Bullen, Microsoft.public.excel.programming, 98/04/08
'Get the handle for a window
Declare Function wapiFindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String)
As Long
'Extract an icon from a file
Declare Function wapiExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal
nIconIndex As Long) As Long
'Send a Windows message
Declare Function wapiSendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As
Integer, ByVal lParam As Long) As Long
Public Const WM_SETICON = &H80
Sub ChangeIcon()
Dim sName As String
sName = "C:\club.ico"
'Uncomment the next line to restore the standard Excel icon. Give the right
path
'sName = "F:\Office\Excel.exe"
Call procSetIcons(sName)
End Sub
Sub procSetIcons(sIconPath)
Dim a As Long, ihWnd As Long, ihIcon As Long
'Get the handle of the Excel window
ihWnd = wapiFindWindow("XLMAIN", Application.Caption)
'Get the icon from the source
ihIcon = wapiExtractIcon(0, sIconPath, 0)
'1 means invalid icon source, 0 means no icons in source
If ihIcon > 1 Then
'Set the big (32x32) and small (16x16) icons
a = wapiSendMessage(ihWnd, WM_SETICON, True, ihIcon)
a = wapiSendMessage(ihWnd, WM_SETICON, False, ihIcon)
End If
End Sub

Pour l'utilisation d'un mot de passe, des exemples
http://disciplus.simplex.free.fr/xl/protection.htm

Effacer les cellules vides
[A1:F30].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft

Le controle ProgressBar

Lancer une commande DOS
Essaie Shell "Command.com /c " & ta_commande_dos
Par exemple, pour lister tout le contenu du lecteur C :
Shell "Command.com /c dir/s/b", vbMaximizedFocus
Si tu veux que la fenêtre DOS reste ouverte après exécution, remplace /c
par /k

Barre de titre perdue?:
Essaie de supprimer (ou renommer) le fichier XLB et relance Excel.
Sinon
Démarrer Exécuter "c:\Program Files\Microsoft Office\Office\Excel.exe" /o
ou "c:\Program Files\Microsoft Office\Office\Excel.exe" /Regserver

Comment ouvrir le classeur sur une feuille déterminée?
le plus simple est de fermer le classeur sur cette feuille
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Sheets("Accueil").Activate
End Sub
sinon
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Accueil").Activate
Application.ScreenUpdating = true
End Sub

Lors de l'éxécution d'une macro, je veux modifier un userform, or l'affichage n'est modifié qu'a la fin de la macro
Ajouter avant de lancer la macro l'instruction:
DoEvents

Comment trouver la dernière colone ou la dernière ligne utilisée?
si c'est la dernière de la ligne 1
Sub test()
rep = Range("iv1").End(xlToLeft).Column
rep1 = Cells(1, rep).Address(, False)
rep2 = Application.Find("$", rep1) - 1
MsgBox Left(rep1, rep2)
End Sub
si c'est la dernière colonne quelque soit la ligne
Sub test()
ActiveSheet.UsedRange
rep = Selection.SpecialCells(xlCellTypeLastCell).Column
rep1 = Cells(1, rep).Address(, False)
rep2 = Application.Find("$", rep1) - 1
MsgBox Left(rep1, rep2)
End Sub
ou
MsgBox Split(ActiveCell.Address, "$")(1)
MsgBox Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
MsgBox Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
MsgBox Left(ActiveCell.Address(1, 0), InStr(1, ActiveCell.Address(1, 0),"$") - 1)
MsgBox Mid(Chr((ActiveCell.Column - 1) \ 26 + 64) & Chr(((ActiveCell.Column - 1) Mod 26) + 65), (ActiveCell.Column < 27) * -1 +1)
MsgBox Left(Mid(ActiveCell.Address, 2), Len(Mid(ActiveCell.Address, 2)) -
(Len(Mid(Mid(ActiveCell.Address, 2), Application.Search("$",Mid(ActiveCell.Address, 2), 1) + 1)) + 1))
ou
Cells.Find("*", , , , , xlPrevious).Select
ou
Dim Colonne As String
Colonne = ActiveSheet.UsedRange.Address(, False)
MsgBox Mid(Colonne, 1, InStr(1, Colonne, "$") - 1)

Quand je lance Excel, je me retrouve automatiquement en mode "étendre la sélection des cellules"
Essaie ceci :
Démarrer, Exécuter, "C:\Program Files\Microsoft Office\Office\Excel.exe"
/REGSERVER
(en respectant les parenthèses, en modifiant éventuellement le chemin d'accès)
Sinon
- quelle souris utilises-tu , le bon driver a-t'il été installé ?
- s'il s'agit d'une souris avec molette, essaie de cliquer plusieurs fois sur la molette pour annuler le mode extension de sélection.
- essaie de changer la souris

Pour quitter l'application
Application.Quit
pour fermer sans préavis (Attention pas d'enregistrement !!!)
Application.DisplayAlerts = False
Application.Quit

Comment cacher une macro du menu macro?
Ajouter "Optional Factice As String" et elle disparaitra.
Sub CacherMacro(Optional Factice As String)
MsgBox "Salut DJ9B"
End Sub

Comment se placer sur la dernière cellule d'un tableau sans utiliser la souris ou le curseur?
Touche pour aller en bas sans selectionner : Crtl+flèche en bas
Avec sélection : Crtl+Shift+Flèche en bas

Peut-on faire apparaitre un msgbox quelques secondes et le faire disparaitre sans cliquer sur ok?
Une astuce bricolée avec une Form, car avec un MsgBox comme il est modal tu ne peux rien faire sans le fermer en cliquant sur OK
A mettre dans un module standard ou dans le module ou tu appelle ta Userform qui devra contenir un bouton (eventuellement minuscule) dont le code sera:
userform1.hide
Sub Afficher()
UserForm1.Show False 'False = non modale
'2 secondes
Application.OnTime Now + TimeValue("00:00:02"), "Fermer"
End Sub
Sub Fermer()
SendKeys "{ENTER}"
End Sub
De même, à mettre dans le module de ta Form. Si tu ne veux pas que ton
utilisateur le ferme avant les Api supprime la croix.
'Recup du handle
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
'récup du style
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'défini le nouveau style
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal _
dwNewLong As Long) As Long
Const GSTYLE = -16
Const SYSMENU = &H80000
Private Sub UserForm_Initialize()
Dim Identifiant As Long
Dim Style As Long
'récupère le handle de la Form
Identifiant = FindWindow("thunderdframe", Me.Caption)
'récupère le style actuel de la Form
Style = GetWindowLong(Identifiant, GSTYLE)
'supprime la croix de fermeture
Style = (Style And Not SYSMENU)
'Défini le nouveau style
SetWindowLong Identifiant, GSTYLE, Style
End Sub
Autre methode qui me plait mieux!
Sub TimedMessage()
Const Title As String = "Self closing message box"
Const Delay As Byte = 2 ' Tps d'affichage en secondes
Const wButtons As Integer = 0 + 64 ' Boutons + icone
Dim wsh As Object, msg As String
Set wsh = CreateObject("WScript.Shell")
msg = Space(10) & "Bonjour," & vbLf & vbLf & "Nous sommes le " & Date
wsh.Popup msg, Delay, Title, wButtons
Set wsh = Nothing
End Sub

Cette ligne de commande rend "impossible" la visualisation
de la feuille par l'usager(même savoir qu'elle existe) sans avoir accès au code du projet. Exemple d'utilisation:
Worksheets("feuil1").Visible = xlVeryHidden

Effacer une feuille ou une partie:
Tout effacer (du moins le contenu)
Cells.ClearContents
pour une plage
Range("b1:c10").ClearContents
Pour tout effacer Format, contenu..
utiliser clear

Les mises à jour Microsoft et ajouts pour Excel 97/98

Comment éviter le message de confirmation à l'enregistrement d'un classeur?
Il y a deux façons:
En incluant la commande suivante en tête de la macro
Application.displayAlert=false
en faisant croire à excel que le classeur a déjà été enregistré.
ThisWorkbook.Saved = True
ThisWorkbook.Close

Comment mettre en pied de page, le chemin et le nom du fichier?
Dans la boite de dialogue, mise en page, onglet entête / pied de page, tu as un bouton pied de page personnalisé.
Une nouvelle boite de dialogue s'ouvre et tu as une série de boutons.
Certains te permettent d'insérer le chemin d'accès au fichier (&[Chemin d'accès]&[Fichier])
Les autres le nom du classeur, de l'onglet...

Enregistrer un classeur sous un autre nom, en le vidant au passage d'une partie de son code fs, mpfe
Sub SaveAsWithoutMacros()
Dim NomSource$, CheminDest$, NomDest$
Dim VBC As Object
'variables à adapter
NomSource = "EssaiSaveAs.xls"
CheminDest = "C:\Windows\Temp\"
NomDest = "Essai.xls"
'copie du classeur source
Workbooks(NomSource).SaveAs CheminDest & NomDest
'(qui devient le classeur actif)
With ActiveWorkbook.VBProject
DelProc ThisWorkbook, "ThisWorkbook", "Workbook_Open"
DelProc ThisWorkbook, "Feuil1", "Worksheet_Activate"
DelProc ThisWorkbook, "Module1", "MaMacro"
End With
Application.Quit
SendKeys "%O"
End Sub
'supprimer une procédure d'un module et uniquement cette procédure
Sub DelProc(Wbk As Workbook, CodeMod$, NomProc$)
Dim liDeb, NbLi
With Wbk.VBProject.VBComponents(CodeMod).CodeModule
liDeb = .ProcStartLine(NomProc, 0)
NbLi = .ProcCountLines(NomProc, 0)
.DeleteLines liDeb, NbLi
End With
End Sub 'fs

Existerait il une fonction ou une commande qui permettrait de rechercher l'emplacement d'une valeur de cellule ou d'une formule dans un classeur autre que celui que l'on a ouvert et ce sans bien sûr l'ouvrir.
Public Function GetValue(ByVal path, ByVal file, ByVal sheet, ByVal ref) As Variant
' Macro XL4 Merci à John Walkenbach
' ==============================
' Retrieves a value from a closed workbook
Dim Arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
Arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1)
' MsgBox Arg
' Execute an XLM macro
GetValue = Application.ExecuteExcel4Macro(Arg)
DoEvents
End Function
Utilisation :
Sub Test()
MsgBox GetValue("C:\Mes Documents\","MonFichier.xls","MaFeuille","A")
End Sub
1 La fonction de John Walkenbach n'est utilisable qu'en VBA, donc la formule (dans une cellule) =GetValue(...) ne marche pas !
Ceci pour la raison simple qu'il suffit de rentrer dans une cellule...
='C:\Mes Documents\[MonFichier.xls]MaFeuille!A1
... pour que tout marche à merveille !
2 Frédéric Sigonneau a (toujours) raison les deux méthodes (VBA et Formule) fonctionnent dans tous les cas de figures :
classeur protégé, feuille masquée ou très masquée...
On se demande vraiment à quoi servent les différentes protections !!!!
OU AVEC LES COORD' CELLULES Cells(l,c)
Public Function GetValue(ByVal path, ByVal file, ByVal sheet, ByVal c, ByVal l) As Variant
' Macro XL4 Merci à John Walkenbach
' Retrieves a value from a closed workbook
Dim Arg As String
' Vérifie l'existence du fichier
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Crée l'argument
Arg = "'" & path & "[" & file & "]" & sheet & "'!" & Cells(l,c).Address(, , xlR1C1)
' Arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(Cells(l, c)).Address(, , xlR1C1)
' Execute an XLM macro
GetValue = Application.ExecuteExcel4Macro(Arg)
DoEvents
End Function

Je voudrais effectuer une somme de noms distincts en bas d'une colonne alors que certains noms apparaissent plusieurs fois dans la colonne.
La matricielle suivante
=SOMME(SI(NBCAR(A2:A100);1/NB.SI(A2:A100;A2:A100)))

Pour rechercher une chaîne et supprimer la ligne complète
où est trouvé la chaîne ....
Private Sub EnleverLignes()
Dim D As Range, C As Range, MonCritère As String
MonCritère = "aa"
On Error Resume Next
For Each C In Worksheets("Feuil1").Columns(7). _
SpecialCells(xlCellTypeConstants, xlTextValues)
If C.Value = MonCritère Then
If Not D Is Nothing Then
Set D = Union(D, C)
Else
Set D = C
End If
End If
Next
D.EntireRow.Delete
Set D = Nothing: C = Nothing
End Sub

Sauver un classeur au format HTML
Attribute VB_Name = "CreerPageWeb"
Sub PublishObjectExample()
'Robert Rosenberg, mpep
Dim oPO As PublishObject
'Set a reference to the Publish object
Set oPO = ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
"C:\My Documents\LABRCR\ExcelData\Page.htm", "District A", "", xlHtmlCalc)
'Publish it (Save it as HTML)
oPO.Publish True
'Display the unique identifier number
'This will be different each time this code is run.
MsgBox oPO.DivID
End Sub

Je souhaiterais que quelqu'un m'explique pourquoi certaines macros n'apparaissent pas quand on fait : "Outil - Macro - Macro".
Les macros ne sont pas visibles dans la boite de dialogue "Macro" lorsque :
- la macro est déclarée Private
- elle est publique mais l'option Option Private Module est en tête du module où
elle est écrite
- elle est publique mais possède un ou des paramètres
- elle est publique, avec ou sans paramètres, mais appartient à une macro
complémentaire
Malgré cela, il est possible d'exécuter la macro depuis la boite de dialogue
Outils\Macro\Macros en tapant son nom dans la zone "Nom de la macro" puis
Exécuter.
Sauf si la macro a un ou des paramètres. Dans ce cas, elle doit être publique.
Petit exemple :
- macro avec paramètres :
(le type des paramètres peut être précisé ou Variant)
Sub macro(s, i) '(s As String, i As Integer)
MsgBox "coucou"
End Sub
- dans la zone "Nom de la macro", taper :
(la "ligne de commande" doit être entourée de quotes simples)
'macro "un",4'
(puis Exécuter)

Pour connaître le numéro de la première ligne du résultat du filtre automatique...
Sub NuméroLigne()
On Error Resume Next
If ActiveSheet.AutoFilterMode = True Then
With Range("_FilterDatabase")
MsgBox .Offset(1).Resize(.Rows.Count - 1, Columns.Count).SpecialCells(xlCellTypeVisible).Row
End With
End If
End Sub

Plus de 230 macro-commandes pour Excel.
Vous êtes nombreux parmi les internautes à utiliser le logiciel Excel et à connaître ses possibilités. Pour les autres sachez que ce logiciel (payant) est un tableur qui permet de contrôler, gérer, trier et mettre en forme des données.
Il peut s'agir par exemple de souhaiter gérer sa collection vidéo, un planning annuel ou un carnet d'adresses, suivre toutes vos finances concernant votre voiture, son entretien, l'assurance, les pleins d'essence ou de gasoil, etc.
La création de ces fichiers Excel n'est pas forcément des plus faciles pour un néophyte. Heureusement le site "Excel Downloads" vous propose plus de 230 macro-commandes permettant l'utilisation d'applications très intéressantes.
- Excel-downloads
Les macro-commandes sont présentées dans le menu suivant : Utilitaires, Business, Gestion Finance, Convertisseurs, Loisirs Sports, Bricolage, Jeux, Microsoft et Divers.
Voici quelques exemples de macro-commandes qui vous montrerons l'étendue du choix proposé :
- Gestion des notes de frais.
- ExeStock : logiciel de gestion de stock.
- Karcher : nettoyage des classeurs excel de tout ce qui est inutile.
- Pochette-CD : réalisation des pochettes pour CD, CD de données ou CD audio.
- Chonometre projets : ce programme permet de chronométrer le temps passé sur différents projets, puis de pouvoir les totaliser.
Vous le comprendrez, chacun peut trouver son bonheur, il suffit de passer un peu de temps sur le site. Notez que les fichiers à télécharger sont peu volumineux, donc, un gain de temps en perspective.

Companims [v 1.0 ß] Win Me Win 95 Win 98 Freeware WAHRENBERGER Olivier
pctuning.free.fr
anshare.com [16 Ko]
Companims est une feuille Microsoft Excel 97 qui incorpore des boutons.
Chaque bouton lance une animation du compagnon Office choisi.
Dans cette version, les boutons s'appellent "Bouton1", "Bouton2",...
Tout le code VBA est fourni, la feuille n'est pas protégée.

Excel --> HTML [v 1.0] Freeware [143,18 Ko] Français
Transformation d'un tableau Excel exporté au format texte en tableau HTML.

Les versions d'excel
Pour les versions 1 à 5, aucune difficulté. Ensuite est sortie la version 95
qui est une version 7 (pas de version 6, car Microsoft a voulu rendre homogènes
les numéros de version des Applis Office). Excel est ainsi passé de 5 à 7 tandis
qu'Access passait de 2 à 7 !
La version 7 était une simple adaptation d'Excel 5 à Windows 95. Il y a très peu de
différences dans les fonctionnalités, et pour cette raison, il n'y a pas eu de version 7
pour Excel Mac.
Au delà :
Windows Mac
8 97 98
9 2000 2001
10 XP X
Dans (10.4302.4219), les chiffres avant le point représentent le numéro de version.
La suite correspond aux "Builds" versions Beta, puis sous-versions successives
(version initiale, puis SR1, SR2, ... (SR pour Service Release ou SP pour Service Pack).
En VBA, Application.Version renvoie le numéro de version, et Application.Build celui de
la ... Build ;-))
Précision : Excel 2002 et Excel xp sont 2 appellations différentes
pour le même produit.

'Procédure appelante : Ouvre un fichier et désactive les macros de ce dernier.
Sub OuvrirFichierSansActiverLesMacros()
OpenFileWithoutMacro "c:\Mes documents", "Les classeurs.xls"
End Sub
'----------------------------
Sub OpenFileWithoutMacro(Chemin As String, Fichier As String)
'Désactive complètement l'exécution des macros du fichier.
'N'affecte pas le comportement des autres fichiers ouverts.
'Cette procédure doit être appelé à partir de la feuille
'de calcul et non de la fenêtre VBE à cause des commandes
'Les 2 commandes suivantes s'assurent que
'la fenêtre "Open" pointe vers le bon répertoire
SendKeys "{esc}"
Application.Dialogs(xlDialogOpen).Show Chemin
'Ouvre le fichier en désactivant la macro.
SendKeys "%Fo" & Fichier & "%od"
End Sub

Selectionner toutes les lignes à partir de la ligne selectionnée
Sélectionner le n° de ligne puis MAJ + CTRL + Flèche bas

Remettre un tableau à zéro rapidement, tout en conservant les formules
Edition/Atteindre
cliquez sur le bouton Cellules
Cochez constantes et
Nombres, si vous voulez effacer les données numériques
Texte, si vous voulez vider les cellules contenant du texte
Valeurs logiques, si vous voulez effacer les valeurs vrai ou faux
Ok
Maintenant que les cellules contenant des constantes (valeurs sans formule) sont sélectionnées appuyez sur la touche Suppr.

Suppression des doublons dans une liste
Public Sub SupprDoublon()
Dim flleNouv As Worksheet, flleActu As Worksheet
Dim rDoublon As Range
Set flleActu = ActiveSheet
Set rDoublon = Selection
'exécute un filtre élaboré sans critère et sans doublon
rDoublon.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'ajoute une feuille
Set flleNouv = Worksheets.Add
'sélectionne uniquement les cellules visibles
rDoublon.SpecialCells(xlCellTypeVisible).Copy
' on colle ces cellules dans la nouvelle feuille
flleNouv.Range("A1").PasteSpecial xlPasteAll
'on affiche tout pour annuler le filtre
flleActu.ShowAllData
'on efface tous le contenu de la plage
rDoublon.ClearContents
' on copie les données de la nouvelle feuille et on les colle dans la sélection
flleNouv.Range("A1").CurrentRegion.Copy rDoublon.Cells(1)
'on supprime la nouvelle feuille
Application.DisplayAlerts = False
flleNouv.Delete
Application.DisplayAlerts = False
End Sub (vu sur CathyAstuces)

Nombre de jours ouvrables
avec la macro complémentaire utilitaires d'analyse cochée
=nb.jours.ouvres(debut;fin;feriés)

'Cette macro donne le numero de ligne et la lettre de la colonne
Sub ColLigne()
Colonne = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
Ligne = ActiveCell.Row
MsgBox Colonne & Ligne
MsgBox Colonne
MsgBox Ligne
End Sub

'Affiche le numéro de la dernière ligne du tableau
MsgBox Rows(Cells.Find("*", , , , , xlPrevious).Row).Row

'dernière ligne et dernière colonne
derlin = feuil.Cells.Find("*", , , , , xlPrevious).Row
dercol = feuil.Cells.Find("*", , , , xlByColumns, xlPrevious).Column

Cellule clignotante
Tiré de http://disciplus.simplex.free.fr/xl/formats.htm#clignotant
Sans macro, pas possible dans excel...
Avec une macro de Bill Manville :
Pour créer une cellule qui clignote :
Définit un nouveau style (format/style/Flash/ajouter)
Applique le à la cellule que tu choisis, place le code suivant dans un module de feuille et lance la procédure flash en tant que auto-open.
Le texte clignote entre rouge et blanc.
Dim NextTime As Date
Sub Flash()
NextTime = Now +
TimeValue("00:00:01")
With ActiveWorkbook.Styles("Flash").Font
If .ColorIndex = 2 Then .ColorIndex = 3 Else .ColorIndex = 2
End With
Application.OnTime NextTime, "Flash"
End Sub
Sub StopIt()
Application.OnTime NextTime, "Flash", schedule:=False
ActiveWorkbook.Styles("Flash").Font.ColorIndex = xlAutomatic
End Sub
****************************
Autre solution :
Comment faire pour qu'une cellule clignote quand la souris passe dessus.
Pour faire clignoter la cellule B5.
1. Sors la boîte à outils Contrôles,
2. Insère un contrôle Image (sans image !) sur ta cellule,
3. Choisis les propriétés suivantes pour ton contrôle :
BackStyle : Transparent
BorderStyle : None
4. Le contrôle doit avoir les mêmes dimensions que ta cellule,
5. Utilise alors les deux macros suivantes :
Private Sub Image1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call Clignote
End Sub
Sub Clignote()
For i = 1 To 50
With [B5].Interior
.ColorIndex = 3
ColorIndex = xlNone
End With
Next i
End Sub

Envoyer un fichier par e-mail:
Private Sub CommandButton1_Click()
Dim Dest As String, Objet As String
Dim Corps As String, Rep As String
Dest = "Destinataire@Fournissseur"
'Définir le chemin et le fichier à expédier.
Rep = "C:\Mes documents\classeur1.xls"
Objet = "Est-ce que tu l'as reçu ce ... fichier?"
Corps = "Bonjour The Boss," & vbCrLf & vbCrLf
Corps = Corps & "Je t'en veux un peu puisqu'en rédigeant cette procédure" & vbCrLf
Corps = Corps & "Je me suis arraché le dernier poil sur le coco." & vbCrLf & vbCrLf
Corps = Corps & "Espérons que cela va fonctionner cette fois pour toi." & vbCrLf & vbCrLf
Corps = Corps & "Salutations!" & vbCrLf & vbCrLf
Corps = Corps & "MichDenis"
Shell "C:\Program Files\Outlook Express\msimn.exe " & _
"/mailurl:mailto:" & Dest & _
"?subject=" & Objet & _
"&Body=" & Corps, vbMaximizedFocus
'Active la ligne de code qui correspond à ton exigence.
'Envoyer le fichier sans fichier attaché
'SendKeys "%s"
'Pour afficher le courriel + fichier attaché
'SendKeys "%I" & "p" & Rep & "~"
'Envoyer le courriel + fichier attaché de façon automatique
SendKeys "%I" & "p" & Rep & "~" & "%s"
End Sub

Une petite remarque sur ta méthode de calcul de la dernière ligne :
Ligne = ActiveSheet.UsedRange.Rows.Count
Par cette méthode, on obtient la dernière ligne réellement utilisée seulement
si la feuille active contient des données en ligne 1.
Sinon le résultat est faux (et la suite de la procédure risque de ne pas donner les résultats attendus...).
Exemple : dans une feuille vierge, écrivez"toto" en A5, A6 et A7. Exécutez ensuite ce genre de procédure :
Sub test()
MsgBox ActiveSheet.UsedRange.Rows.Count
End Sub
Le message indique 3 alors que la dernière ligne utilisée sur la feuille est la ligne 7...
Pour corriger le tir, il faut commencer par récupérer la ligne à laquelle commence la partie utilisée de la feuille :
Sub test()
With ActiveSheet.UsedRange
MsgBox .Row + .Rows.Count - 1
End With
End Sub
UsedRange n'est pas un mauvais choix pour déterminer les
dernières ligne/colonne utilisées dans une feuille mais demande des précautions d'usage.

Pour mettre à jour les liens vers les autres fichiers en VBA
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

Paramètres personnalisés
Les options de démarrage d'Excel 97 ne permettent pas de transmettre des paramètres personnalisés au logiciel.
La technique suivante, non documentée, permet de réaliser cette opération.
Cette technique a été testée uniquement avec Excel 97 / Windows 95.
Elle devrait marcher avec Excel 95 et 97 tournant sous Windows 95 ou 98.
Elle ne fonctionnera pas avec Windows NT, et je ne sais pas si elle est adaptable à Excel 5 / Windows 3.1.
Le truc consiste à lancer Excel avec une option valide, par exemple /e (empêchant le chargement d'un classeur vide au démarrage) et à greffer immédiatement après cette option les paramètres personnels.
En effet, les caractères qui suivent les options de démarrage, jusqu'au premier espace rencontré, sont ignorés par Excel.
Ils ne génèrent donc pas d'erreur et sont exploitables par macro, via la fonction API GetCommandLine.
Par exemple, si l'on veut démarrer Excel en ouvrant le classeur "C:\Temp\Test.xls" en lui transmettant les paramètres "r", "h" et "report.dbf", la ligne de commande devrait être de ce type :
- à partir de DOS : start excel c:\temp\test /e/r/h/report.dbf
- à partir d'un programme VB : Shell "c:\...\excel.exe c:\temp\test /e/r/report.dbf"
Les paramètres doivent suivre immédiatement /e et ne doivent comprendre aucun espace.
Leur récupération peut s'opérer immédiatement après le lancement d'Excel par le biais d'une macro Workbook_Open ou Auto_Open placé dans le classeur ouvert.
Cette macro doit récupérer le contenu de la ligne de commande par GetCommandLine et utiliser les fonctions de chaîne de caractères pour localiser et séparer les paramètres personnels.
A titre d'exemple, la macro suivante récupère les paramètres dans une variable tableau (Args) et copie ce tableau dans la première feuille de calcul du classeur.
Option Base 1
Declare Function GetCommandLineA Lib "Kernel32" () As String
Dim Args() As String
Sub Auto_open()
Dim CmdLine As String
Dim ArgCount As Integer
Dim Pos1 As Integer, Pos2 As Integer
CmdLine = GetCommandLineA
Pos1 = InStr(1, CmdLine, "/e/") + 3
If Pos1 = 3 Or Pos1 = Len(CmdLine) Then Exit Sub
Do While Pos1 <> 1
Pos2 = InStr(Pos1, CmdLine, "/")
ArgCount = ArgCount + 1
ReDim Preserve Args(ArgCount)
Args(ArgCount) = Mid(CmdLine, Pos1, _
IIf(Pos2, Pos2, Len(CmdLine)) - Pos1)
Pos1 = Pos2 + 1
Loop
Worksheets(1).Range("A1:A" & ArgCount) = _
WorksheetFunction.Transpose(Args)
End Sub
Rappel des options de démarrage d'Excel 97 :
Les paramètres peuvent être utilisés en majuscule ou minuscule. Plusieurs paramètres consécutifs doivent être séparés par des espaces.
/automation : force Excel 97 à démarrer sans charger aucun add-in, ni aucun modèle ou classeur installé dans le répertoire Xlouvrir.
/e, /embedded : fore Excel à démarrer sans créer un classeur vide (Classeur1).
/i : force Excel à démarrer avec une fenêtre occupant tout l'écran.
/m : force Excel à s'ouvrir sur un nouveau classeur contenant seulement une feuille macro Excel 4.
/o : complète les entrées manquantes concernant Excel dans la base de registre.
La clé suivante est modifiée : HKEY_CURRENT_USER\Software\Microsoft\Office\8.0\Excel
/p <dossier> : change le dossier (répertoire) actif après avoir chargé Excel.
/r <fichier> : force Excel à ouvrir le fichier indiqué en lecture seule.
/s : force Excel à ignorer tous les fichiers installés dans le répertoire Xlouvrir.
/regserver : réinitialise les entrées de la base de registre d'Excel, puis ferme le logiciel.
/unregserver : vide les entrées de la base de registre et quitte Excel.
Ces infos ont été extraites des pages longre.free.fr à visiter.

FindLink.zip v8.6 (0/073, 35k)
Pour chercher les liens d'un classeur, ouvrir ou installer FINDLINK.XLA, activer le classeur et faire outils / Chercher les liens.
Il vous demande un texte à chercher.
Vous pouvez spécifier le nom d'un classeur spécifique (ex:"SOURCE.XLS") ou seulement ".XLS" pour trouver les références à tous les fichiers .XLS.
Vous pouvez aussi entrer "#REF" pour trouver tous les noms qui font référence à des zonnes éffacées ou à des noms de zones pour trouver où ces zones sont utilisées.
Optionnellement cet utilitaire liste les occurences, liste et efface (substutuant des valeurs quand c'est approprié), ou vous demande quoi faire avec chaque occurence.
Utilitaire trouvé sur ce site the excel MVP Page

Insérer une image dans un Userform

convertir un classeur excel en html et faire une copie sans les formules
Dim nbfeuilles As Integer
Sub copiehtml()
'placer ici les variables
'placer en haut de code dim nbfeuilles as integer
fictemp = "fichierOrigine.xls" 'le fichier avec les formules
fichier = "copie.xls" 'le fichier allégé
ficmenu = fictemp 'le fichier contenant le menu pour executer cette macro, peut être le fichier original ou un autre dédié à cette tache.
classeur = "nom" 'indique le nom des pages excel suivi d'un numéro de séquence

Application.ScreenUpdating = False
'ouvre les classeurs si fermés
On Error Resume Next
Windows(fictemp).Activate
If fictemp = ficmenu Then t = 1 Else t = 0
nbfeuilles = Worksheets.Count - t 'on ne copie pas le menu
If Err <> 0 Then Workbooks.Open FileName:=ActiveWorkbook.Path + "\temp.xls"
On Error GoTo 0
On Error Resume Next
Windows(fichier).Activate
If Err <> 0 Then Workbooks.Open FileName:=ActiveWorkbook.Path + "\" + fichier
On Error GoTo 0

'copie de fictemp.xls sur fichier par valeurs
For t = 1 To nbfeuilles 'on ne copie pas le menu
Windows(fictemp).Activate
If Sheets(t).Visible = True Then
Sheets(t).Activate
maxline = Range("a65536").End(xlUp).Row
maxcol = ActiveSheet.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
ActiveSheet.UsedRange.Select
Selection.Copy
Windows(fichier).Activate
Sheets(t).Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
End If
Next t
Windows(fichier).Activate
Sheets(1).Select
ActiveWorkbook.Save 'enregistrement afin que la copie se fasse bien sur intranet
Windows(fictemp).Activate

'création du fichier index
mytitle = classeur
If nbfeuilles > 1 Then
DocDestination = ActiveWorkbook.Path + "\" & classeur & ".htm"
If Len(Dir(DocDestination)) > 1 Then Kill DocDestination
Open DocDestination For Output As 1
Print #1, "<HTML>" & Chr$(13)
Print #1, "<TITLE>" & mytitle & "</TITLE>" & Chr$(13)
Print #1, "<meta http-equiv=" & Chr(34) & "Content-Type" & Chr(34) & " content=" & Chr(34) & "text/html; charset=iso-8859-1" & Chr(34) & ">" & Chr$(13)
Print #1, "<META NAME=" & Chr(34) & "Author" & Chr(34) & " Content=" & Chr(34) & "votre nom" & Chr(34) & ">"
Print #1, "<BODY bgcolor=" & Chr(34) & "#9F9F9F" & Chr(34) & " >" & Chr$(13)
Print #1, index(Feuille, classeur)
Print #1, "<CENTER><TABLE bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & " Border=1 cellspacing=0 width=" & Chr(34) & "100%" & Chr(34) & ">" & Chr$(13)
Print #1, "</TABLE></CENTER></FONT></BODY></HTML>" & Chr$(13)
Close
End If

For t = 1 To nbfeuilles
'mettre ici les différents paramètres correspondant à chaque tableau
Feuille = Sheets(t).Name
If Sheets(t).Visible = True Then
Sheets(Feuille).Select
mytitle = Sheets(t).Name
maxline = Range("a65536").End(xlUp).Row
maxcol = ActiveSheet.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
MyRange = "A1:" & Cells(maxline, maxcol).Address()
DocDestination = ActiveWorkbook.Path + "\" & classeur & t & ".htm"
Call RangeToHTM(MyRange, Feuille, DocDestination)
End If
Next t

'copie des fichiers .htm dans le répertoire intranet d:\prive_pro\
Shell "Command.com /c " & ActiveWorkbook.Path + "\copie.bat", vbMinimizedFocus
Windows(ficmenu).Activate
Sheets("Menu").Select
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.Quit
End Sub
Sub RangeToHTM(MyRange, Feuille, DocDestination)
' cette macro convertit un tableau Excel en table html.
' La plupart du format est préservé. La taille des fontes, des lignes et colonnes sont ignorées.
' MyRange est le tableau excel à convertir.
Sheets(Feuille).Select
ColCount = Range(MyRange).Columns.Count
rowcount = Range(MyRange).Rows.Count
'CalcState = Application.Calculation
'Application.Calculation = xlCalculationAutomatic
'Calculate
mytitle = Selection.Range(MyRange).Cells(1, 1).Text
If Len(Dir(DocDestination)) > 1 Then Kill DocDestination
Open DocDestination For Output As 1
'crée le code html
Print #1, "<HTML>" & Chr$(13)
Print #1, "<TITLE>" & mytitle & "</TITLE>" & Chr$(13)
Print #1, "<meta http-equiv=" & Chr(34) & "Content-Type" & Chr(34) & " content=" & Chr(34) & "text/html; charset=iso-8859-1" & Chr(34) & ">" & Chr$(13)
Print #1, "<META NAME=" & Chr(34) & "Author" & Chr(34) & " Content=" & Chr(34) & "Votre nom" & Chr(34) & ">"
Print #1, "<BODY bgcolor=" & Chr(34) & "#9F9F9F" & Chr(34) & " >" & Chr$(13)
Row = 0 'on teste si les cellules sont encadrées
Range(MyRange).Cells(1, 1).Select
If Selection.Borders(xlEdgeLeft).LineStyle = xlNone Then bord = 0 Else bord = 1
Print #1, "<CENTER><TABLE bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & " Border=" & bord & " cellspacing=0 >" & Chr$(13)

Row = 0
While Row < rowcount
Row = Row + 1
nblig = 0 'hauteur des colones non encadrées verticalement
'on teste si les cellules sont encadrées à gauche, si on passe de encadré a non encadré
'ou vice versa, on ouvre un autre tableau
Range(MyRange).Cells(Row, 1).Select
If Selection.Borders(xlEdgeLeft).LineStyle = xlNone Then
If bord = 1 And Row > 1 Then
bord = 0
Print #1, "</TABLE><CENTER><TABLE bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & " Border=" & bord & " cellspacing=0 >" & Chr$(13)
End If
Else
If bord = 0 And Row > 1 Then
bord = 1
Print #1, "</TABLE><CENTER><TABLE bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & " Border=" & bord & " cellspacing=0 >" & Chr$(13)
End If
End If
'on teste si la cellule A gauche est encadrée en bas afin de faire dans ce cas des colones
Range(MyRange).Cells(Row, 1).Select
If Selection.Borders(xlEdgeBottom).LineStyle = xlNone And _
Selection.Borders(xlEdgeLeft).LineStyle <> xlNone And _
Selection.Borders(xlEdgeRight).LineStyle <> xlNone And Row + nblig < rowcount Then
While Range(MyRange).Cells(Row + nblig, 1).Borders(xlEdgeBottom).LineStyle = xlNone
nblig = nblig + 1
Wend
End If

If (Not Range(MyRange).Rows(Row).Hidden) Then
MV = ""
col = 0
While col < ColCount
col = col + 1
'on teste si la colonne est cachée
If (Not Range(MyRange).Columns(col).Hidden) Then
taille = calctaille(Range(MyRange).Cells(Row, col).Font.Size)
CC = Range(MyRange).Cells(Row, col).Interior.ColorIndex
BGC = couleur(CC)
'test si cellule en % et supérieure à 100%
If Len(Range(MyRange).Cells(Row, col).Text) > 1 Then
temp = Left(Range(MyRange).Cells(Row, col).Text, Len(Range(MyRange).Cells(Row, col).Text) - 1)
End If
If Right(Range(MyRange).Cells(Row, col).Text, 1) = "%" _
And Val(temp) >= "100" And nblig = 0 Then
BGC = "#CCFFCC" 'vert clair
End If
If Len(BGC) > 2 Then BGC = " bgcolor=" & Chr$(34) & BGC & Chr$(34) Else BGC = " bgcolor=" & Chr$(34) & "#FFFFFF" & Chr$(34)
CC = Range(MyRange).Cells(Row, col).Font.ColorIndex
TC = couleur(CC)
If Len(TC) > 2 Then TC = "<font color=" & Chr$(34) & TC & Chr$(34) & taille & ">" Else TC = "<font color=" & Chr$(34) & "#000000" & Chr$(34) & taille & ">"
cellv = Range(MyRange).Cells(Row, col).Text
cellv = substitue(cellv, Chr(10), "<BR>")
cellv = substitue(cellv, " ", "&nbsp;")
If cellv = "" Or Range(MyRange).Cells(Row, col).Value = "0" Then cellv = Chr(38) & "nbsp" 'chr(38)="&" 'remplace cellule vide par espace
'lit les lignes suivantes si on doit faire une colone sans cadres horizontaux
If nblig > 0 Then
'test si cellule en % et supérieure à 100%
If Len(cellv) > 1 Then
temp = Left(cellv, Len(cellv) - 1)
End If
If Right(cellv, 1) = "%" _
And Val(temp) >= "100" Then
cellv = "<font color=" & Chr(34) & "#336600" & Chr(34) & "><B>" & cellv & "</B></font>"
End If
For t1 = 1 To nblig
cellx = Range(MyRange).Cells(Row + t1, col).Text
cellx = substitue(cellx, Chr(10), "<BR>")
cellx = substitue(cellx, " ", "&nbsp")
If cellx = "" Or Range(MyRange).Cells(Row + t1, col).Value = "0" Then cellx = Chr(38) & "nbsp" 'remplace cellule vide &nbsp
'test si cellule en % et supérieure à 100%
If Len(cellx) > 1 Then
temp = Left(cellx, Len(cellx) - 1)
End If
If Right(cellx, 1) = "%" _
And Val(temp) >= "100" Then
cellx = "<font color=" & Chr(34) & "#336600" & Chr(34) & "><B>" & cellx & "</B></font>"
End If
cellv = cellv & "<BR>" & cellx
Next t1
End If

HzA = Range(MyRange).Cells(Row, col).HorizontalAlignment
CellA = " Align=Right "
If HzA = -4108 Then CellA = " Align=Center "
If HzA = -4131 Then CellA = " Align=Left "
If Range(MyRange).Cells(Row, col).Font.Bold Then cellv = "<B>" & cellv & "</B>"
If Range(MyRange).Cells(Row, col).Font.Italic Then cellv = "<I>" & cellv & "</I>"
If HzA = 7 Or Range(MyRange).Cells(Row, col).MergeCells Then
ColSpan = 0
SameTitle = True
While (Range(MyRange).Cells(Row, col).HorizontalAlignment = 7) And SameTitle
If Not Range(MyRange).Columns(col).Hidden Then ColSpan = ColSpan + 1
col = col + 1
If (Len(Range(MyRange).Cells(Row, col).Text) > 0) Then
SameTitle = False
col = col - 1 'Or Range(MyRange).Cells(Row, col).MergeCells = False
End If
Wend
CellA = " ColSpan=" & ColSpan & " Align=center "
End If
MV = MV & "<TD" & BGC & CellA & ">" & TC & cellv & "</FONT></TD>"
End If
Wend
Print #1, "<TR>" & MV & "</TR>" & Chr$(13)
If nblig > 0 Then Row = Row + nblig
End If
Wend
Print #1, "</TABLE></CENTER></FONT></BODY></HTML>" & Chr$(13)
Close
End Sub
Function couleur(CC)
Select Case CC
Case 1
c = "#000000" 'black"
Case 2
c = "#FFFFFF"
Case 3
c = "#FF0000" 'Red"
Case 4
c = "#00FF00" 'green"
Case 5
c = "#0000FF"
Case 6
c = "#FFFF66" 'yellow"
Case 7
c = "#FF00FF"
Case 8
c = "#00FFFF" 'blue
Case 9
c = "#993333"
Case 10
c = "#336600"
Case 11
c = "#000066"
Case 12
c = "#666633"
Case 13
c = "#990099"
Case 14
c = "#006666"
Case 15
c = "#CCCCCC" 'gris
Case 16
c = "#666666"
Case 17
c = "#9999FF"
Case 18
c = "#990066"
Case 19
c = "#FFFFCC"
Case 20
c = "#CCFFFF"
Case 21
c = "#660066"
Case 22
c = "#FF9999"
Case 23
c = "#0066CC"
Case 24
c = "#CCCCFF"
Case 25
c = "#000066"
Case 26
c = "#FF00FF"
Case 27
c = "#FFFF00"
Case 28
c = "#00FFFF"
Case 29
c = "#660066"
Case 30
c = "#993333"
Case 31
c = "#009999"
Case 32
c = "#0000CC"
Case 33
c = "#00CCFF"
Case 34
c = "#CCFFFF"
Case 35
c = "#CCFFCC"
Case 36
c = "#FFFF99"
Case 37
c = "#99CCFF"
Case 38
c = "#FF99CC"
Case 39
c = "#CC99FF" 'Purple
Case 40
c = "#FFCC99"
Case 41
c = "#0066FF"
Case 42
c = "#00CCCC"
Case 43
c = "#99CC00"
Case 44
c = "#FFCC66"
Case 45
c = "#FF9900"
Case 46
c = "#FF6633"
Case 47
c = "#9999CC"
Case 48
c = "#999999"
Case 49
c = "#333366"
Case 50
c = "#009966"
Case 51
c = "#003300"
Case 52
c = "#333333"
Case 53
c = "#996633"
Case 54
c = "#990066"
Case 55
c = "#003399"
Case 56
c = "#003333"
End Select
couleur = c
End Function
Function calctaille(t)
Select Case t
Case 8
s = "1" '"-7"
Case 9
s = "1" '"-6"
Case 10
s = "2" '"-5"
Case 11
s = " 2" '"-4"
Case 12
s = "0" '"-3" taille par défaut correspond a 3
Case 14
s = "0" '"-2"
Case 16
s = "4" '"-1"
Case 18
s = "4" '"0"
Case 20
s = "5" '"+1"
Case 22
s = "5" '"+2"
Case 24
s = "6" '"+3"
Case 26
s = "6" '"+4"
Case 28
s = "7" '"+5"
Case 36
s = "7" '"+6"
Case 48
s = "7" '"+7"
End Select
If s <> "0" Then calctaille = " size=" & s Else calctaille = ""
End Function
Function index(Feuille, classeur)
temp = "<CENTER><TABLE bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & " Border=1 cellspacing=0 width=" & Chr(34) & "100%" & Chr(34) & "><TR>"

For t = 1 To nbfeuilles
If Sheets(t).Visible = True Then
onglet = Sheets(t).Name
fichier = classeur & t & ".htm"
If onglet <> Feuille Then BGC = " bgcolor=" & Chr(34) & "#CCCCCC" & Chr(34) Else BGC = ""
temp = temp & "<TD align=center" & BGC & "><A href=" & Chr(34) & fichier & Chr(34) & " target=cad4>" & onglet & "</A></TD>"
End If
Next t

temp = temp & "</TR></TABLE></CENTER>" & Chr(13)
If nbfeuilles = 1 Then temp = ""
index = temp
End Function

Function substitue(c, c1, c2)'pour excel 97 en antérieur
t = 1
temp = c
While t > 0
'remplace caractère c1 par caractère c2
t = InStr(temp, c1)
If t > 0 Then
temp = Left(temp, t - 1) & c2 & Mid(temp, t + Len(c1))
End If
Wend
substitue = temp
End Function
Si vous avez des idées pour améliorer cette macro, faites moi en part. Tout le monde en profitera.

Pour créer une cellule qui clignote :
Définit un nouveau style (format/style/Flash/ajouter)
Applique le à la cellule que tu choisis, place le code suivant dans un module de feuille et lance la procédure flash en tant que auto-open. Le texte clignote entre rouge et blanc.
Dim NextTime As Date
Sub Flash()
NextTime = Now +
TimeValue("00:00:01")
With ActiveWorkbook.Styles("Flash").Font
If .ColorIndex = 2 Then .ColorIndex = 3 Else .ColorIndex = 2
End With
Application.OnTime NextTime, "Flash"
End Sub

Pour passer en plein écran
Dans la feuille de code ThisWorkbook

Private Sub Workbook_Open()
Dim cmdB As CommandBar
For Each cmdB In Application.CommandBars
cmdB.Enabled = False
Next cmdB
' si tu veux masquer en plus la barre d'état
' la barre de formule
' les onglets...
With Application
.DisplayFullScreen = True
.DisplayStatusBar = False
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayWorkbookTabs = False
.DisplayHeadings = False
End With
'
End Sub

'puis les remettre à la fermeture du classeur

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cmdB As CommandBar
For Each cmdB In Application.CommandBars
cmdB.Enabled = True
Next cmdB
With Application
.DisplayFullScreen = False
.DisplayStatusBar = True
.DisplayFormulaBar = True
End With
With ActiveWindow
.DisplayWorkbookTabs = True
.DisplayHeadings = True
End With
End Sub

Excel se plante à l'ouverture que faire?
supprimer le fichier c:\windows\application data\microsoft\excel\excel.xlb

Comment trier les onglets d'une feuille?
Trois méthodes au choix (trouvées sur Excel Labo) :
Sub TrieFeuilles()
Dim i As Integer
Dim J As Integer
Dim Min As Integer
Dim ModeCalcul As Integer
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets
For i = 1 To .Count - 1
Min = i
For J = i + 1 To .Count
If .Item(J).Name < .Item(Min).Name Then Min = J
Next J
If Min <> i Then .Item(Min).Move before:=Worksheets(i)
Next i
End With
Application.Calculation = ModeCalcul
Application.ScreenUpdating = True
Sheets("Feuil1").Select
End Sub

'Trie les onglets des feuilles d'un fichier excel par ordre alphabétique.
Deuxième!
Sub TriChaqueFeuilles()
Dim X As Variant
Dim i As Variant
For Each X In ActiveWorkbook.Sheets
For i = 2 To ActiveWorkbook.Sheets.Count
If Sheets(i - 1).Name > Sheets(i).Name Then
Sheets(i - 1).Move After:=Sheets(i)
End If
Next
Next
Sheets("Feuil1").Select
End Sub

Troisième
Sub TrieOnglets()
Dim F
Dim i As Long
For Each F In ActiveWorkbook.Sheets
For i = 2 To ActiveWorkbook.Sheets.Count
If UCase(Sheets(i - 1).Name) > UCase(Sheets(i).Name) Then _
Sheets(i - 1).Move After:=Sheets(i)
Next i
Next F
End Sub