|
XLDnaute Barbatruc
Date d'inscription: février 2005
Messages: 3 622
|
[REF] Wiki Page 4 de MichelXld
Les sujets abordés dans cette page :
- Les fonctions mathématiques et trigonométriques , Les impressions , Les temporisations , Les fonctions , Les evenements , Excel , Les cellules , Copier & Coller , Les dates et les calendriers , Les spécificités Macintosh , Générer des fichiers Flash , Open Office .
Lien vers la wiki page 1 :Les feuilles , Les graphiques , Les images , Les propriétés des classeurs , Les sauvegardes , Les formes automatiques , Aleatoire , Les barres d'outils et les barres de menus , Les boites de dialogues intégrées , Les classeurs . Lien vers la wiki page 2 : Les userforms : Les Checkbox , Les Labels , Les combobox , Les Commandbutton , Les Listbox ,Les Multipages , Les Frames , Les Textbox , Les imagesList , Les Treeview , Les Listview , Les Images , Les Webbrowser , Les calendriers , Les progressbar , Les Spreadsheet , Les Chartspaces , Les commonDialog , Les MSFlexGrid. Lien vers la wiki page 3 :Piloter d'autres applications depuis Excel , Piloter ( Word , Outlook , Power Point ) , Les fichiers texte Lien vers la wiki page 4 : Les fonctions mathématiques et trigonométriques , Les impressions , Les temporisations , Les fonctions , Les evenements , Excel , Les cellules , Copier & Coller , Les dates et les calendriers , Les spécificités Macintosh, Générer des fichiers Flash , Open Office Lien vers la wiki page 5 : Les formules Excel , Les audits de formules , Les répertoires et les fichiers . Lien vers la wiki page 6 : Les doublons , Les tris et les filtres , Les variables , Piloter les fichiers fermés (Excel , Access ,les fichiers DBF) . Lien vers la wiki page 7 : Les commentaires , La gestion des erreurs , L'aide en ligne Excel , Les recherches dans un classeur, Les tableaux , Les pages html et internet , Windows Media Player , Le PC et le systême d'exploitation ,Piloter Flash , les types de boucles. Lien vers la wiki page 8 : Piloter MSN Messenger et Windows Messenger , Les objets dans le feuille , Les liens hypertextes , Les formats , Visual basic editor , Les chaines de caractères , Les modules de classe. Lien vers la wiki page 9 : Les mises en forme conditionnelles , Les Tableaux et graphiques Croisés Dynamiques , Gérer les fichiers XML depuis Excel , Piloter Open Office depuis Excel. Lien vers la wiki page 10 : Le Publipostage Word / Excel. Lien vers la wiki page 11 : Utiliser la librairie Windows Image Acquisition Automation Library v2.0 depuis Excel.
Les fonctions mathématiques- Afficher la racine carré d'un nombre par la fonction Sqr
Sub Test() Msgbox Sqr(9) ' 3 Msgbox Sqr(50) ' 7,07106781186548 Msgbox Sqr(0) ' 0 End Sub
- La fonction Sgn permet de déterminer le signe d'un nombre
Les valeurs renvoyées : Si supérieur à zéro : 1 Si égal à zéro : 0 Si inférieur à zéro : -1 Sub Test() Msgbox Sgn(20.4) ' 1 Msgbox Sgn(-44) ' -1 Msgbox Sgn(0) '0 End Sub
- Utiliser les fonctions des feuilles Excel par Vba
Par exemple calculer la moyenne de la plage A1:A5 Sub calculMoyenne() Msgbox Application.Worksheetfunction.Average(Range("A1:A5 ")) End Sub
- Calculer la somme de la plage A1:A5 par macro
Sub calculSomme() Msgbox Application.Worksheetfunction.Sum(Range("A1:A5")) End Sub
- Convertir des Fahrenheit en Celsius
Sub conversion_Fahrenheit_Celsius() Dim Fahr As Variant Fahr = inputBox("Saisir la température en Fahrenheit :", _ "Conversion Fahrenheit en Celsius", 0) If Fahr = "" Then Exit Sub msgBox Fahr & " Fahrenheit = " & Format((5 / 9) * (Fahr - 32), "0.000") & " Celsius ." End Sub
- Calculer la surface d'un cercle
Sub surfaceCercle() Dim Rayon As Variant Rayon = inputBox("Saisir le rayon :", "Calcul surface d'un cercle", 0) If Rayon = "" Then Exit Sub If Sgn(Rayon) > 0 Then msgBox "La surface est : " & _ Format(Application.worksheetFunction.Pi * Rayon ^ 2, "0.0000"), , _ "Surface cercle-Rayon=" & Rayon End Sub
- Calculer le volume d'un cylindre droit
Sub volumeCylindreDroit() Dim Rayon As Variant, Hauteur As Variant Rayon = inputBox("Saisir le rayon :", "Calcul volume d'un cylindre droit ", 0) If Rayon = "" Then Exit Sub Hauteur = inputBox("Saisir la hauteur :", "Calcul volume d'un cylindre droit ", 0) If Hauteur = "" Then Exit Sub If Sgn(Rayon) > 0 And Sgn(Hauteur) > 0 Then msgBox "Le volume est : " & _ Format(Application.worksheetFunction.Pi * Rayon ^ 2 * Hauteur, "0.0000"), , _ "volume cylindre droit-Rayon=" & Rayon & " Hauteur=" & Hauteur End Sub
- Calculer le volume d'une sphère
Sub volumeSphere() Dim Rayon As Variant Dim vS As Double Rayon = inputBox("Saisir le rayon :", "Calcul volume d'une sphère ", 1) If Rayon = "" Then Exit Sub vS = Application.worksheetFunction.Pi * (Rayon ^ 3) * 4 / 3 msgBox "Le volume est : " & Vs End Sub
- Vérifier si la valeur de la cellule A1 est un nombre premier
Sub verificationNombrePremier() Dim Valeur As Long, Diviseur As Long Valeur = Range("A1") Diviseur = 1 If Valeur > 1 Then Do Diviseur = Diviseur + 1 Loop While Valeur Mod Diviseur <> 0 End If If Diviseur =Valeur Then msgBox Valeur & " est un nombre premier", , "Resultat" Else msgBox Valeur & " n'est pas un nombre premier", , "Resultat" End If End Sub
- Chercher les 3 plus grandes valeurs d'une plage
Sub troisPlusgrandesValeurs() Dim Plage As Range Dim i As Byte 'les valeurs à rechercher sont dans la colonne A Set Plage = Columns(1) For i = 1 To 3 'resultat s'affiche dans la colonne B Cells(i, 2) = Application.worksheetFunction.Large(Plage, i) Next i End Sub
- La difference entre la fonction Round et Application.worksheetFunction.Round
Le lien sur le forum XLD Le lien sur Internet
- Vérifier si un nombre est un multiple de 10
Dim maVariable As Integer maVariable = 50 If maVariable Mod 10 = 0 Then msgBox "est un multiple de 10"
- Quelle valeur ajouter à un nombre pour obtenir un multiple de 10
Dim maVariable As Integer maVariable = 32 If maVariable Mod 10 <> 0 Then msgBox 10 - (maVariable Mod 10) Else msgBox 0 End If
La Trigonométrie- Afficher le cosinus , le Sinus et la Tangente d'un angle
L'argument x entre parentheses exprime la valeur d'un angle en radians Pour convertir des radians en degrés, multipliez-les par 180/pi Sub test() Dim x As Double 'exemple pour un angle de 30 degrés 'transformation en radians x = 30 * Application.Worksheetfunction.Pi / 180 'résultats Msgbox Cos(x) 'cosinus Msgbox 1 / Cos(x) 'secante Msgbox Sin(x) 'sinus Msgbox 1 / Sin(x) 'cosecante Msgbox Tan(x) 'tangente Msgbox 1 / Tan(x) 'cotangente End Sub
Les impressions- Imprimer une feuille
Sub imprimerUneFeuille() Sheets("feuil2").printOut End Sub
- Imprimer toutes les feuilles du classeur
Dim Ws As Worksheet For Each Ws In thisWorkbook.Worksheets Ws.printOut Next
- Imprimer une plage de cellules
Sub imprimerPlageCellules() Sheets("feuil1").Range("A1 10").printOut End Sub
- Aperçu de la Feuille nommée "Feuil2" avant impression
Sub previsualiserAvantPrint() Sheets("Feuil2").printPreview End Sub
- Effectuer l'aperçu avant impression en utilisant les boites de dialogues intégrées d'Excel
Application.Dialogs(xlDialogPrintPreview).Show Remarque : L'argument False permet de rendre inactifs les boutons "mise en page" et "Marges" Application.Dialogs(xlDialogPrintPreview).Show False
- Imprimer la page active et les tous les classeurs liés
Sub imprimerPageActiveEt_Liensclasseurs() Dim Lien As Hyperlink Dim I As Byte Application.screenUpdating = False Activesheet.printOut For Each Lien In activeSheet.Hyperlinks If Right(Range(Lien.Range.Address).Hyperlinks(1).Addr ess, 4) = ".xls" Then Range(Lien.Range.Address).Hyperlinks(1).Follow newWindow:=False For I = 1 To activeWorkbook.Sheets.Count activeWorkbook.Sheets(I).printOut Next I activeWorkbook.Close End If Next Application.screenUpdating = True End Sub
- Imprimer une feuille sans couleur de fond
Le lien sur le forum XLD Le fichier zippé
- Choix par inputBox du nombre de copies à imprimer
Sub imprimeClasseur() Dim X As Byte On Error goTo gestionErreur X = inputBox("Saisir le nombre de copies à effectuer . ", "Impression") activeWorkbook.printOut Copies:=X, Collate:=True Exit Sub gestionErreur: If Err = 13 Then msgBox "Saisie non valide ." End Sub
- Imprimer une Feuille en noir et blanc
Sub impressionNoirEtBlanc() With Worksheets("Feuil1") .pageSetup.blackAndWhite = True 'parametrage N&B .printOut 'imprimer .pageSetup.blackAndWhite = False'réinitialisation End With End Sub
- Changer temporairement l'imprimante active
Le lien sur le forum XLD
- Afficher l'aperçu des sauts de page , de la feuille active
Sub afficherSautsDePage() activeWindow.View = xlPageBreakPreview End Sub
- Masquer l'aperçu des sauts de page , de la feuille active
Sub masquerLesSautsDePage() activeWindow.View = xlNormalView End Sub
- Afficher la boite de dialogue d'impression, en précisant le nombre de copies
'Dans l'exemple le nombre de copies par défaut =3 Sub boiteDialogueImpression() Application.Dialogs(xlDialogPrint).Show , , , 3 End Sub
- Afficher la boite de dialogue pour le choix de l'imprimante
Sub boiteDialogueChoixImprimante() Application.Dialogs(Excel.xlBuiltInDialog.xlDialog PrinterSetup).Show End Sub
- Sélectionner l'imprimante pour l'édition
If Application.Dialogs(xlDialogPrinterSetup).Show = True Then Feuil1.printOut
- Empècher l'impression
Private Sub Workbook_beforePrint(Cancel As Boolean) Cancel = True End Sub
- Signaler la fin d'impression par un msgBox
Le lien sur le forum XLD
- Suivre l'impression des documents
La macro "Suivi_Impression_V02" permet d'afficher dans la barre de statut des informations sur le document en cours d'édition : le nombre de pages déja imprimées le nombre total de pages à imprimer le nom du document en cours d'impression La macro "Temporisation" permet de rafraichir régulierement les informations( toutes les 2 secondes dans l'exemple ) La macro "Finir" termine la procedure lorsque la file d'attente d'impression est vide voir la procedure du : 23-11-04 00:46 dans le fil de discussion Le lien sur le forum XLD Un autre exemple : Le fichier zippé
- Lister les imprimantes installées et préciser laquelle est active
Sub listeImprimantes_et_Statut() 'testé avec Excel2002 et WinXP Dim objWMIService As Object, colInstalledPrinters As Object, objPrinter As Object Dim nomPC As String, Resultat As String nomPC = "." Set objWMIService = getObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & nomPC & "\root\cimv2") Set colInstalledPrinters = objWMIService.execQuery("Select * from Win32_Printer") For Each objPrinter In colInstalledPrinters Resultat = Resultat & objPrinter.Name & " imprimante active : " & objPrinter.Default & vbLf Next msgBox Resultat End Sub
- Afficher les propriétés des imprimantes installées
Sub proprietesImprimantes() Dim objWMIService As Object, colItems As Object Dim objItem As Object Dim strComputer As String Dim i As Byte On Error Resume Next strComputer = "." Set objWMIService = getObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.execQuery("Select * from Win32_printerConfiguration", , 48) For Each objItem In colItems i = i + 1 Cells(1, i) = "bitsPerPel: " & objItem.bitsPerPel Cells(2, i) = "Caption: " & objItem.Caption Cells(3, i) = "Collate: " & objItem.Collate Cells(4, i) = "Color: " & objItem.Color Cells(5, i) = "Copies: " & objItem.Copies Cells(6, i) = "Description: " & objItem.Description Cells(7, i) = "deviceName: " & objItem.deviceName Cells(8, i) = "displayFlags: " & objItem.displayFlags Cells(9, i) = "displayFrequency: " & objItem.displayFrequency Cells(10, i) = "ditherType: " & objItem.ditherType Cells(11, i) = "driverVersion: " & objItem.driverVersion Cells(12, i) = "Duplex: " & objItem.Duplex Cells(13, i) = "formName: " & objItem.formName Cells(14, i) = "horizontalResolution: " & objItem.horizontalResolution Cells(15, i) = "ICMIntent: " & objItem.ICMIntent Cells(16, i) = "ICMMethod: " & objItem.ICMMethod Cells(17, i) = "logPixels: " & objItem.logPixels Cells(18, i) = "mediaType: " & objItem.mediaType Cells(19, i) = "Name: " & objItem.Name Cells(20, i) = "Orientation: " & objItem.Orientation Cells(21, i) = "paperLength: " & objItem.paperLength Cells(22, i) = "paperSize: " & objItem.paperSize Cells(23, i) = "paperWidth: " & objItem.paperWidth Cells(24, i) = "pelsHeight: " & objItem.pelsHeight Cells(25, i) = "pelsWidth: " & objItem.pelsWidth Cells(26, i) = "printQuality: " & objItem.printQuality Cells(27, i) = "Scale: " & objItem.Scale Cells(28, i) = "SettingID: " & objItem.SettingID Cells(29, i) = "specificationVersion: " & objItem.specificationVersion Cells(30, i) = "TTOption: " & objItem.TTOption Cells(31, i) = "verticalResolution: " & objItem.verticalResolution Cells(32, i) = "XResolution: " & objItem.Xresolution Cells(33, i) = "YResolution: " & objItem.Yresolution Columns(i).autoFit Next End Sub
Afficher les propriétés de la zone d'impression d'une imprimante (marges horizontales et verticales)
Le lien sur Internet - Modifier la mise en page avant impression
Sub miseEnPageAvantImpression() With Feuil1.pageSetup .leftMargin = Application.inchesToPoints(0.5) .rightMargin = Application.inchesToPoints(0.75) .topMargin = Application.inchesToPoints(1.5) .bottomMargin = Application.inchesToPoints(1) .headerMargin = Application.inchesToPoints(0.5) .footerMargin = Application.inchesToPoints(0.5) End With Feuil1.printPreview End Sub
- Arreter l'impression en cours et vider la file d'attente
Le lien sur le forum XLD
- Définir la zone d'impression sur une plage de cellules
activeSheet.pageSetup.printArea = "$A$1:$E$10"
- Adapter la zone d'impression à une seule feuille
With Sheets(1).pageSetup .printArea = "A1:M100" .Zoom = False .fitToPagesWide = 1 .fitToPagesTall = 1 End With
- Réinitialiser la zone d'impression à la feuille complete
activeSheet.pageSetup.printArea = "" Une autre possibilité : activeSheet.pageSetup.printArea = False
- Vérifier si l'imprimante est parametree pour imprimer en Noir et Blanc ou en couleur
( Voir le message du 18/08/2005 20:54 ) Le lien sur le forum XLD
- Répéter l'insertion des 4 premieres lignes dans toutes les pages imprimées
menu Fichier Mise en page onglet "Feuille" dans le champ "Lignes à repeter en haut" , tu selectionnes les 4 lignes qui devront apparaître sur chaque page imprimée tu peux aussi saisir directement dans ce champ $1:$4
- Centrer le contenu de la feuille lors de l'impression
With Feuil1 .pageSetup.centerHorizontally = True .pageSetup.centerVertically = True .printOut End With
- Imprimer un fichier texte
Shell "notepad.exe /P""C:\monRepertoire\leFichier.txt""", 1
- Ouvrir le port d'impression pour éditer un texte
Sub imprimerTexte() Open "LPT1:" For Output As #1 Print #1, "test d'impression." Print #1, "test 2eme ligne." Close #1 End Sub
- Imprimer le 2eme graphique contenu dans le Feuil1
Feuil1.chartObjects(2).Chart.printOut
- Imprimer la Feuil1 d'un Addin (.xla)
With Workbooks("test.xla") .isAddin = False .Worksheets("Feuil1").printOut Copies:=1, Collate:=True .isAddin = True End With
- Imprimer la première page en mode Paysage et la deuxième page en mode Portrait
With Feuil1 .pageSetup.Orientation = xlLandscape .printOut From:=1, To:=1 .pageSetup.Orientation = xlPortrait .printOut From:=2, To:=2 End With
Les temporisations- Effectuer une pause dans la procédure
Declare Sub Sleep Lib "kernel32" (byVal dwMilliseconds As Long) Sub macroAvecPause() 'le debut de la macro Sleep 1000 'pause en millisecondes 'la suite de la macro End Sub
- Paramétrer la durée d'une action : 5 secondes dans cet exemple
t = Timer + 5: Do Until Timer > t: doEvents: Loop
- La méthode onTime permet d'éxécuter les procedures à un moment précis( exemples issus de l'aide Excel)
Exécuter my_Procedure dans 15 secondes. Application.onTime Now + timeValue("00:00:15"), "my_Procedure" Exécuter my_Procedure à 17 heures. Application.onTime timeValue("17:00:00"), "my_Procedure" Annuler le paramétrage de onTime de l'exemple précédent. Application.onTime earliestTime:=timeValue("17:00:00"), Procedure:="my_Procedure", Schedule:=False
- Relancer une macro de façon récursive toutes les 2 secondes , tant qu'une condition n'est pas remplie
'la macro incrémente la cellule B1 d'une unité toutes les 2 secondes ' saisir la valeur 1 dans la cellule A1 pour terminer la procedure !! '*************************************** Sub lancerLaProcedure() Temporisation End Sub '*************************************** ''************************************** Sub Temporisation() 'timer toutes les 2 secondes Application.onTime Now + timeValue("00:00:02"), "maMacro" End Sub Sub maMacro() Range("B1") = Range("B1") + 1 'incementation de la cellule B1 If Range("A1") = 1 Then ' terminer la procedure si la cellule A1=1 Finir Exit Sub End If Temporisation End Sub Sub Finir() On Error Resume Next Application.onTime Now + timeValue("00:00:01"), "maMacro", , Schedule:=False End Sub '*****************************************
- Un compte à rebours pour fermer un Userform
Le fichier zippé
Les fonctions- La fonction Val et les valeurs décimales :
Pour extraire les données décimales avec la fonction Val , il faut remplacer la virgule par un point
- Utiliser la fonction DROITEREG ( LINEST) par macro
Dim y_connus(), x_connus() y_connus = Array(5, 2, 1) x_connus = Array(6, 3, 4) Range("A1") = worksheetFunction.linEst(y_connus, x_connus)
- Lancer une procédure contenue dans une macro complémentaire .XLA
Cet exemple lance une macro issue de l'utilitaire d'analyse - VBA (ATPVBAEN.XLA) msgBox Application.Run("ATPVBAEN.XLA!WORKDAY", 12/11/2005, 10, 5)
- Utiliser une fonction matricielle SOMMEPROD par macro
La macro correspond à cette formule: SOMMEPROD((E58:E183=H60)*(C58:C183=I60)*(B58:B183= J60)*(F58:F183)) Les arguments H60, I60 et J60 seront maintenant des données saisie dans les Textbox d'un Userform msgBox Evaluate("=SUMPRODUCT((E58:E183 =""" & textBox1.Text & """) * " & _ "(C58:C183 =""" & textBox2.Text & """) * (B58:B183 =""" & textBox3.Text & """) * (F58:F183))")
- La fonction Switch: Renvoyer la donnée associée à un mot
Sub Test() msgBox valeurEquivalente("Vert") End Sub Function valeurEquivalente(Couleur As String) valeurEquivalente = Switch(Couleur = "Bleu", 5, Couleur = "Vert", 4, Couleur = "Rouge", 3) End Function
- La fonction IIf : Renvoyer l'un ou l'autre de deux arguments selon l'évaluation d'une expression.
(informations issues de l'aide en ligne Excel) IIf(Expr, Truepart, Falsepart) Expr : Expression à évaluer. Truepart : Valeur ou expression renvoyée si la valeur de Expr est True. Falsepart : Valeur ou expression renvoyée si la valeur de Expr est False. Exemple : Attribuer une donnée à la cellule A1 en fonction du contenu de la variable Cible Dim Cible As String Cible = "Bleu" Range("A1") = IIf(Cible = "Vert", "x", "y") Remarque :L'argument Falsepart est évalué même si la valeur de Expr est Vraie .
Les evenements- Débuter : comment afficher un message à l'ouverture du classeur
Le fichier zippé
- Empecher l'affichage du menu contextuel lors du clic droit dans la feuille
Private Sub Workbook_sheetBeforeRightClick(byVal Sh As Object, _ byVal Target As Range,Cancel As Boolean) Cancel = True End Sub
- Emettre un son lors du clic sur un lien hypertexte , à partir d'Excel2000
Private Sub Workbook_sheetFollowHyperlink(byVal Sh As Object, byVal Target As Hyperlink) Beep End Sub
- Utilisez la propriété enableEvents pour désactiver les procédures évenementielles et pour éviter certaines boucles infinies
Private Sub Workbook_sheetChange(byVal Sh As Object, byVal Target As Excel.Range) Application.enableEvents = False ...ma macro… 'TRES IMPORTANT : ne pas oublier de remettre la valeur True en fin de macro Application.enableEvents = True End Sub
- Appeler l'evenement Click d'un commandButton ( placé dans une feuille ) depuis une autre macro
Application.Run ("Feuil1.commandButton1_Click")
- Afficher un message lors du clic sur la cellule E10
Private Sub Worksheet_selectionChange(byVal Target As Range) If Not Application.Intersect(Target, Range("E10")) Is Nothing Then msgBox "bonjour" End Sub d'autres exemples très détaillés , par @+Thierry Le lien sur le forum XLD Déclencher une action si la Feuil1 est activée ( affichage d'un USF dans l'exemple) Private Sub Workbook_sheetActivate(byVal Sh As Object) If Sh.Name = "Feuil1" Then userForm1.Show End Sub
- Réinitialiser le menu contextuel ( clic droit dans la feuille )
Une démo de Didier myDearFriend La procédure permet de supprimer les menus personnalisés présents dans le menu contextuel Le lien sur le forum XLD Le fichier zippé Un autre exemple Sub reinitialiserMenuContextuelDisparu() Application.commandBars("cell").Reset End Sub
- Intercepter l'evenement changement de la couleur du fond des cellules
Option Explicit Dim x As Integer Dim Cell As String Private Sub Worksheet_selectionChange(byVal Target As Range) On Error Resume Next If Cell = "" Then x = Target.Interior.colorIndex Cell = Target.Address Exit Sub End If If Range(Cell).Interior.colorIndex <> x Then _ msgBox "la couleur de la cellule " & Cell & " a changé" x = Target.Interior.colorIndex Cell = Target.Address End Sub
- Déclencher une procédure evenementielle contenue dans un USF ,depuis une macro qui possede une variable
le préfixe "Private" doit etre préalablement oté dans la macro de l'userForm Private Sub Worksheet_Change(byVal Target As Range) callByName userForm1, "commandButton" & Range("A1") & "_Click", vbMethod End Sub
- Remplacer le menu contextuel ( clic droit de la souris ) par l'affichage de la palette de couleurs
La cellule active est coloriee par la couleur sélectionnée Private Sub Worksheet_beforeRightClick(byVal Target As Range, Cancel As Boolean) Dim x As Long Cancel = True Application.Dialogs(xlDialogPatterns).Show x = activeCell.Interior.colorIndex If x = xlColorIndexAutomatic Then x = xlColorIndexNone activeCell.Interior.colorIndex = x End Sub
- Remplacer le menu contextuel par un inputbox qui permet de choisir entre 3 couleurs, pour colorier la cellule active
Private Sub Worksheet_beforeRightClick(byVal Target As Range, Cancel As Boolean) Dim Reponse As Variant Cancel = True Reponse = Application.inputBox("Saisissez une valeur entre 1 et 3" & vbLf & vbLf & _ "1 = Rouge" & vbLf & "2 = Vert" & vbLf & "3 = Bleu", "Colorier la cellule active", 1) If Not isNumeric(Reponse) And Len(Reponse) <> 1 Then Exit Sub If Reponse > 0 And Reponse < 4 Then activeCell.Interior.colorIndex = Reponse + 2 End Sub
Excel- Afficher la version d'excel
Sub versionExcel() msgBox Application.Version End Sub
- Fermer l'application Excel
Sub Ferme() application.Quit End Sub
- Liste des raccourcis clavier d'Excel
Le lien sur le forum XLD
- Modifier le nom de l'utilisateur Excel
Menu Outils Options Onglet Général Nom d'utilisateur
- Moifier le nom de l'utilisateur Excel par macro
Application.userName = "Mon Nom"
- Les spécifications et limites d'Excel (Excel2002)
65536 lignes 256 colonnes Nombre maximal de couleurs par classeur : 56 4 000 styles de cellules 1024 caractères dans une cellule 32767 caractères dans la barre de formule 7 niveaux de fonctions imbriquées 2048 plages sélectionnées 1024 caractères pour la longueur du contenu des formules Précision numérique : 15 chiffres Plus grand chiffre autorisé à taper dans une cellule : 9,99999999999999E+307 Plus grand chiffre positif autorisé : 1,79769313486231E+308 Plus petit chiffre négatif autorisé : -2,2251E-308 Plus petit chiffre positif autorisé : 2,229E-308 Plus grand chiffre négatif autorisé : -1E-307 Longueur du contenu des formules : 1 024 caractères Itérations : 32 767 Arguments dans une fonction : 30 Date la plus ancienne autorisée pour les calculs : 1er janvier 1900 (1er janvier 1904 en cas d'utilisation du système de date basé sur 1904) Date la plus récente autorisée pour les calculs : 31 décembre 9999 Durée maximale pouvant être entrée = 9999:59:59 Ouverture des classeurs Limité par la quantité de mémoire disponible Largeur des colonnes : 255 caractères Hauteur des lignes : 409 points Sauts de page : 1 000 horizontaux et verticaux Longueur du contenu des cellules (texte) : 32 767 caractères. Affichage de 1 024 uniquement dans une cellule et 32 767 dans la barre de formule. Nombre maximal de feuilles par classeur Limité par la quantité de mémoire disponible Nombre maximal de couleurs par classeur : 56 Formats de nombre personnalisés Entre 200 et 250, selon la version linguistique d'Excel que vous avez installée. Noms dans un classeur Limité par la quantité de mémoire disponible Volets dans une fenêtre : 4 Feuilles liées Limité par la quantité de mémoire disponible Scénarios Limité par la quantité de mémoire disponible .251 scénarios seulement sont affichés dans un rapport de synthèse Changement de cellules dans un scénario : 32 Cellules variables dans le Solveur : 200 Fonctions personnalisées Limité par la quantité de mémoire disponible Plage de zoom De 10 pour cent à 400 pour cent Références de tri 3 pour un tri simple, illimité lors de l'utilisation de tris séquentiels Niveaux d'annulation 16 Barres d'outils personnalisées dans un classeur Limité par la quantité de mémoire disponible Boutons de barres d'outils personnalisées Limité par la quantité de mémoire disponible D'autres informations completes sur les spécifications et limites d'Excel Le lien sur Internet
- Modifier le parametre d'annulation des dernieres actions dans le classeur( valeur = 16 par défaut dans Excel )
Le lien sur le forum XLD
- Ouvrir le premier fichier de la liste des classeurs récemments utilisés
Application.recentFiles(1).Open
- Stopper une macro qui ne veut plus s'arreter
Ctrl + Pause
- Débuter : Comment créer une macro dans un classeur
Le fichier zippé
- La fonction intégrée de récupération automatique ( à partir d'Excel 2002 ).
La fonction de récupération automatique enregistre une copie de tous les fichiers Excel ouverts à intervalle régulier défini par l'utilisateur. Il est ainsi possible de récupérer les fichiers si Excel se ferme inopinément, au cours d'une coupure de courant, par exemple. Cette fonction est disponible dans le menu Options , puis l'onglet "Enregistrer" Le lien vers l'aide MSDN
- La suppression des métadonnées d'Office 2003/XP
Lors de la diffusion de documents électroniques Office, ces derniers peuvent contenir des informations que vous ne souhaitez pas partager publiquement, telles que des informations considérées “cachées” ou des informations qui vous permettent de collaborer lors de la rédaction ou de la modification de documents à plusieurs. Microsoft propose un outil pour supprimer ces métadonnées. Le lien sur le site Microsoft
Les cellules- Verifier si la cellule active est ecrite en format gras
Private Sub worksheet_selectionChange(byVal Target As Excel.Range) If Target.Font.Bold = True Then msgBox "oui" Else: msgBox "non" End If End Sub
- Compter le nombre de cellules vides dans la plage A1:F1
msgBox Application.countBlank(Sheets("Feuil1").Range("A1: F1"))
- Afficher le numéro de ligne de la cellule active
msgBox activeCell.Row
- Afficher le numéro de colonne de la cellule active
msgBox activeCell.Column
- Creer une liste deroulante dans une cellule
Sub creerListeDeroulante() Dim Valeur As String Valeur = activeCell.Address With Range(Valeur).Validation .Add Type:=xlValidateList, Formula1:="choix1,choix2" End With End Sub Un autre exemple Sub listeDeroulante() Dim Plage As Object Dim Valeur As String Dim Cible As String Valeur = activeCell.Address Set Plage = Application. _ inputBox("Sélectionnez une plage pour definir la liste de choix : ", Type:=8) If Plage Is Nothing Then Exit Sub Cible = Plage.Address With Range(Valeur).Validation .Add Type:=xlValidateList, Formula1:="=" & Cible End With End Sub
- Afficher un message si la cellule active se trouve dans une plage cible
Private Sub worksheet_selectionChange(byVal Target As Excel.Range) If Not Intersect(Target, Range("A1:F10")) Is Nothing Then msgBox "le forum XLD" End Sub
- Changer le nom d'une cellule avec boucle
Sub changeNomsconditionnel() Dim Nom As Object Dim Cible As String Dim i As Integer, j As Integer Set Nom = activeWorkbook.Names For i = activeWorkbook.Names.Count To 1 Step -1 If Nom(i).nameLocal = "test" Then Cible = Nom(i).refersToLocal Nom(i).Delete activeWorkbook.Names.Add Name:="essai", refersTo:=Cible End If Next i End Sub ou en plus direct , sans boucle Sub changeNomsconditionnel2() Dim Nom As Object Dim Cible As String Set Nom = activeWorkbook.Names Cible = Nom("extraction").refersToLocal Nom("extraction").Delete activeWorkbook.Names.Add Name:="extraction", refersTo:=Cible End Sub
- faire clignoter des cellules de façon conditionnelle
Le lien sur le forum XLD Le fichier zippé Une autre solution , fournie par Didier , myDearFriend Le lien sur le forum XLD Le fichier zippé Le fichier zippé pour Excel97
- Position auto des cellules nommées en haut à gauche de l'écran quand elles sont sélectionnées
Le lien sur le forum XLD Le fichier zippé
- Lister les noms du classeur dans la cellule A1
Range("A1").listNames
- Afficher le nom de la cellule A1
msgBox Range("A1").Name.Name Remarque : la macro renvoie une erreur si la cellule n'est pas nommée
- Lister les cellules et les plages nommées dans l'ordre d'index des feuilles et créer une table des matières avec liens hypertextes
Le lien sur le forum XLD
- Lister les cellules et les plages nommées dans un Userform , puis cliquez dans la liste pour atteindre la cellule
Le lien sur le forum XLD Le fichier zippé
- Modifier la largeur de la colonne A
Sub largeurColonne() Columns(1).columnWidth = 23 End Sub
- Enregistrer une plage de cellules en image au format Jpg
Le lien sur le forum XLD
- Supprimer les retours à la ligne vides dans une cellule
Le lien sur le forum XLD
- Visualiser toutes les cellules fusionnées
Sub visualiserCellulesFusionnees() Dim cell As Range For Each cell In Feuil1.usedRange.Cells If cell.mergeCells = True Then cell.mergeArea.Interior.colorIndex = 6 Next cell End Sub
- Visualiser toutes les cellules contenant des formules , dans la Feuil1
Sub emplacementFormules() Dim Cell As Range For Each Cell In Feuil1.usedRange.Cells If Cell.hasFormula Then Cell.Interior.colorIndex = 4 Next Cell End Sub
- Nommer des cellules non adjacentes , issues d'un filtre automatique
Sub nommerZoneFiltree() activeWorkbook.Names.Add Name:="Zone1", _ refersTo:="=Feuil1!" & Feuil1.autoFilter.Range.specialCells(xlCellTypeVis ible).Address End Sub
- Lister uniquement les noms de la Feuil1
Le lien Internet
- Ajouter une option personnalisée dans le menu contextuel , lors du clic droit dans une cellule
un exemple proposé par Hervé Le lien sur le forum XLD
- Supprimer tous les noms dans le classeur actif
Dim Nom As Name For Each Nom In activeWorkbook.Names Nom.Delete Next Nom
- Empecher la sélection des cellules contenant des formules
'procédure évenementielle , à placer au niveau de la feuille Private Sub Worksheet_selectionChange(byVal Target As Range) Dim Cell As Range For Each Cell In Selection If Cell.hasFormula Then Selection.Cells(1, 1).Offset(, 1).Select Next End Sub
- La propriété currentRegion : exemple pour boucler sur les cellules contigues à la cellule A1
Dim Plage As Range, Cell As Range Set Plage = Range("A1").currentRegion For Each Cell In Plage Debug.Print Cell Next Cell
- Masquer ou Afficher les lignes 5 à 10
Rows("5:10").entireRow.Hidden = True ' masquer Rows("5:10").entireRow.Hidden = False ' afficher
- Insérer une formule dans la cellule B1 , par macro
Remarque : la formule doit etre écrite en anglais dans la macro Range("B1").Formula = "=LINEST(G11:G14,F11:F14,FALSE,TRUE)" Si vous écrivez la formule en français dans la macro ,utilisez "formulaLocal" : Range("B1").formulaLocal = "=DROITEREG(G11:G14;F11:F14;FAUX;VRAI)"
- Protéger une plage de cellules dans la feuille
Sélectionnes toutes les cellules de la feuille Clic droit Selectionnes "format celllules" dans le menu contextuel %% Il faut décocher l'option "verouillé" dans l'onglet protection %% Cliques sur OK pour valider Ensuite tu sélectionnes uniquement la plage de cellules que tu souhaites protéger Clic droit Selectionnes "format celllules" dans le menu contextuel Tu coches l'option "verouillé" dans l'onglet protection Cliques sur OK pour valider Ensuite Menu Outils Protection feuille Protéger feuille Assures toi que l'option "proteger la feuille et le contenu des cellules verouillées" est cochée Saisie ton mot de passe ( en option ) Revalides le mot de passe une 2eme fois Cliques sur OK
- Protéger les cellules qui contiennent des formules dans la feuille Feuil1
Sub protegerCellulesContenantFormules() On Error Resume Next With Feuil1 .unProtect "XLD" 'le mot de passe est facultatif .Cells.Locked = False .Cells.specialCells(xlCellTypeFormulas).Locked = True .enableSelection = xlUnlockedCells .Protect "XLD" 'le mot de passe est facultatif End With End Sub
- Comment aller à la ligne dans une cellule
Combines les touches du clavier : Alt + Entrée ou actives le renvoi automatique dans la cellule Clic droit dans la cellule Format de cellule sélectionnes l'onglet "Alignement" coches l'option "renvoyer à la ligne automatiquement" cliques sur OK pour valider Appliquer un renvoi à la ligne automatique dans la cellule A1 , par Macro Range("A1").wrapText = True
- Effectuer un décalage par rapport à une cellule : la propriété Offset
La propriété Offset permet d'appliquer un décalage par rapport à une cellule de référence La synthaxe est Range("B2").Offset("numero de ligne", "numero de colonne") par exemple : Range("B2").Offset(-1, 2) = "test" le mot "test" va s'afficher 1 ligne plus haut et 2 colonnes sur la droite par rapport à la cellule B2 , soit en cellule D1
- Supprimer toutes les formules dans le classeur actif
Sub supprimeFormulesClasseur() Dim i As Byte On Error Resume Next For i = 1 To Sheets.Count activeWorkbook.Sheets(i).Cells.specialCells(xlCell TypeFormulas).Delete Next i End Sub
- Vérifier si la cellule active est sur un numéro de ligne pair
If activeCell.Row Mod 2 = 0 Then msgBox "oui"
- Effacer le contenu des cellules dans la Feuil1, sans modifier les formats
Sheets("Feuil1").Cells.clearContents
- Accéder à la valeur d'une cellule nommée, d'un autre classeur ouvert.
msgBox Workbooks("classeur.xls").Names("nom").refersToRan ge.Value
- Controler la présence d'une validation (Menu Donnees / Validation) dans la cellule A1
Sub controlePresenceValidation() Dim Vl As Range On Error Resume Next Set Vl = Cells.specialCells(xlCellTypeAllValidation) On Error goTo Fin If Not Intersect(Vl, Range("A1")) Is Nothing Then msgBox "Il y a une Validation dans la cellule" Else msgBox "Il n'y a pas de validation dans la cellule" End If Exit Sub Fin: msgBox "Il n'y a pas de validation dans la feuille" End Sub
- Empecher la sélection des cellules dans la Feuil1 (Alain Vallon)
With Sheets("Feuil1") .enableSelection = xlUnlockedCells .Protect End With
- Verrouiller ou déverouiller la cellule A1 en fonction de la valeur d'une Checkbox
Private Sub checkBox1_Click() If Feuil1.checkBox1.Value = True Then With Feuil1 .Unprotect .Cells.Locked = False .Range("A1").Interior.colorIndex = 6 .Range("A1").Locked = True .enableSelection = xlUnlockedCells .Protect End With Else With Feuil1 .Unprotect .Range("A1").Locked = False .Range("A1").Interior.colorIndex = 3 End With End If End Sub
- Afficher la formule contenue dans la cellule A1
Sub afficherFormlule() Range("A1") = "'" & Range("A1").formulaLocal End Sub Puis réutiliser la formule pour afficher le résultat Sub afficherResultat() Range("A1").formulaLocal = Mid(Range("A1"), 1) End Sub
- Identifier les cellules qui contiennent la fonction SOUSTOTAL
Dim Cell As Range For Each Cell In Range("C1:C20") If Cell.hasFormula And inStr(1, Cell.formulaLocal, "SOUS.TOTAL", vbTextCompare) > 0 Then Cell.Interior.colorIndex = 4 Next
Copier Coller- Copier une feuille dans une nouveau classeur
Workbooks("Classeur1.xls").Sheets("maFeuille").Cop y
- Copier la selection dans la cellule A1 de la feuille2
Sub copierVersFeuille2() Selection.Copy Sheets("feuil2").Range("A1") End Sub
- Copier une plage de cellules dans un nouveau classeur et le sauvegarder
Le lien sur le forum XLD
- Vider le contenu du presse papier
Sub viderPressePapier() 'nécéssite d'activer la référence Microsoft Form 2.0 Object Library Dim Cible As dataObject Set Cible = New dataObject Cible.setText "" Cible.putInClipboard Set Cible = Nothing End Sub
- Récupérer le contenu du presse papier dans une variable
Sub recupererDonneePressePapier() 'nécéssite d'activer la référence Microsoft Form 2.0 Object Library Dim Resultat As String With New dataObject .getFromClipboard Resultat = .getText(1) End With msgBox Resultat End Sub
- Ouvrir un classeur pour copier une de ses feuilles dans un autre document existant puis refermer le classeur
Le lien sur le forum XLD
- Récupérer une image contenue dans le presse papier pour l'enregistrer sur le disque
Le lien sur le forum XLD
- Réaliser une capture d'écran par macro
Private Declare Sub keybd_event Lib "user32" ( _ byVal bVk As Byte, byVal bScan As Byte, byVal dwFlags As Long, _ byVal dwExtraInfo As Long) Private Sub commandButton1_Click() keybd_event vbKeySnapshot, 1, 0&, 0& doEvents Range("A1").Select activeSheet.Paste End Sub
- Coller des données de la "Feuil1" dans une feuille "data" qui est protégée
Worksheets("data").Unprotect Worksheets("Feuil1").Rows("3:3").Copy Worksheets("data").Activate Worksheets("data").Paste _ Destination:=Worksheets("data").Range("A1").End(xl Down).Offset(1, 0) Worksheets("data").Protect
- Empecher l'utilisation du Copier / Coller dans un classeur
Procédures à placer au niveau de Thisworkbook Private Sub Workbook_sheetActivate(byVal Sh As Object) Application.cutCopyMode = False End Sub Private Sub Workbook_sheetSelectionChange(byVal Sh As Object, byVal Target As Range) Application.cutCopyMode = False End Sub
- Bug possible lors de l'utilisation de l'argument xlPasteColumnWidths avec Excel 200 et 2002:
Si vous avez un message d'erreur en utilisant cette synthaxe dans une macro : activeSheet.Range("A1").pasteSpecial Paste:=xlPasteColumnWidths, _ Operation:=xlPasteSpecialOperationNone, skipBlanks:=False, Transpose:=False Vous pouvez remplaçer xlPasteColumnWidths par la valeur 8 . Par exemple : activeSheet.Range("A1").pasteSpecial Paste:=8, _ Operation:=xlPasteSpecialOperationNone, skipBlanks:=False, Transpose:=False
Une démo copyPasteSpecial par Myta
Le lien sur le forum XLD Les dates et les calendriers- Un message à la fermeture du classeur si la date du jour est Vendredi
Private Sub Workbook_beforeClose(Cancel As Boolean) If weekDay(Date, vbSunday) = 6 Then msgBox "Nous sommes Vendredi" End Sub 'Date renvoie la date du jour 'en indiquant vbSunday ,cela precise que le dimanche est le premier 'jour de la semaine 'Weekday renvoie donc le numero du jour dans la semaine ,par rapport au dimanche 'le vendredi est donc le 6eme jour de la semaine
- Supprimer la ligne si la date est dépassée
Si les dates saisies dans la colonne A sont dépassées de 5 jours par rapport à la date du jour , les lignes sont supprimées Sub suppressionSelonDate() Dim Cible As Integer, j As Integer Cible = Range("A65536").End(xlUp).Row Application.screenUpdating = False For j = Cible To 1 Step -1 If Cells(j, 1) < Date - 5 Then Rows(j).Delete Next Application.screenUpdating = True End Sub
- Afficher la date du jour
msgBox Date
- Afficher la date du jour avec un format personnalisé
msgBox Format(Date, "dddd dd mmmm yyyy")
- Fonctions pour obtenir le jour , le mois ou l'annee d'une date cible
msgBox Day("26 mai 1965") msgBox Month("26 mai 1965") msgBox Year("26/05/1965")
- Verifier si un format de date est valide
If isDate("26/05/1965") = True Then msgBox "Ok" Else msgBox "Le donnée n'est pas valide ." End If
- Gestion des interventions d'un parc d'ambulances
Le lien sur le forum XLD Le fichier zippé
- Vérifier le nombre de jours ouvrés entre les dates d'expedition et de livraison , avec une option de statistiques sur le nombre de dépassements
Le fichier zippé
- Naviguer dans les feuilles en choisissant une date dans l'objet Calendar
Le fichier zippé
- Un calendrier d'aide à la saisie des dates dans Excel , par myDearFriend
Le lien sur le forum XLD Téléchargez la Demo de myDearFriend Le fichier texte qui est joint explique comment installer la macro complémentaire .XLA et décrit toutes les options de cet outil indispensable
- Afficher le premier jour du mois , pour une Date saisie dans la cellule A1
Sub premierJourDuMois() Dim Annee As Date, Mois As Date Annee = Year(Range("A1")) Mois = Month(Range("A1")) msgBox Format(dateSerial(Annee, Mois, 1), "dddd dd mmmm yyyy") End Sub Pour afficher le dernier jour du mois précédent msgBox Format(dateSerial(Annee, Mois, 1) - 1, "dddd dd mmmm yyyy")
- Trouver le dernier jour de chaque mois , dans une liste de dates
Le lien sur le forum XLD Le fichier zippé
- Utilisation des formats d'heure dans une macro
exemple qui supprime les lignes si l'heure dans la colonne F est comprise entre 08h00 et 18h00 (format des cellules hh:mm:ss ) Dim x As Integer Dim Cible As Date For x = Range("F65536").End(xlUp).Row To 1 Step -1 Cible = Cells(x, 6) If Cible >= #8:00:00 AM# And Cible <= #6:00:00 PM# Then Rows(x).Delete Next x
- La fonction monthName : afficher le nom d'un mois à partir de son index
'1=Janvier , 2=Février , 3=Mars …etc… msgBox monthName(2) 'L'argument True permet d'afficher le mois en abrégé msgBox monthName(11, True)
- Rechercher dans la plage A1:A10 la date la plus proche du 17/10/2005
Sub rechercheDateProche() Dim Cell As Range Dim Cible As Double, valeurProche As Double, Ecart As Double Cible = 9999999999 For Each Cell In Range("A1:A10") Ecart = Abs(CLng(CDate("17/10/2005")) - CLng(Cell)) If Ecart < Cible Or Ecart = 0 Then Cible = Ecart valeurProche = Cell End If Next msgBox CDate(valeurProche) End Sub
- Afficher l'heure universelle ( méridien de Greenwich ) , un exemple proposé par Michel_m
Sub donner_heureGmt() 'http://www.excel-downloads.com/forums/2-104522-temps-universel.htm Dim datetime As Object Set datetime = createObject("Wbemscripting.swbemdatetime") datetime.setvardate (formatDateTime(Time)) msgBox "heure GMT:" & datetime.getvardate(False) End Sub
- Calendriers Et Plannings 2005 , par Monique et Celeda
Pour que votre plaisir de comptabiliser votre temps ou celui des autres, commence bien avant votre réalisation, Calendriers et Plannings - CEP - vous offre toute une panoplie de classeurs contenant toutes les formules possibles et inimaginables indispensables, à garder sous les yeux pour élaborer vos propres calendriers simples ou compliqués, rapides ou volutifs, avec ou sans couleurs Alors qu'ils s'appellent, Agendas, Calendriers, Semainiers, Gestion du Temps, Feuilles de route, Cycle de Travail, Grille horaire, planifiés, temporels, arrêtez de courir, respirez, soufflez et téléchargez CEP Le lien dans la zone de telechargement XLD
- Retrouver le mois à partir du numéro de semaine et l'index du jour.
'adapté de Daniel Maher, mpfe Dim Annee As Integer, Semaine As Integer, Jour As Integer Dim Cible As Date Semaine = 9 Annee = 2006 Jour = 1 'Lundi= 0 , Mardi=1 , Mercredi=2 ...et… Cible = dateSerial(Annee, 1, 3) - Weekday(dateSerial(Annee, 1, 3)) - 5 + (7 * Semaine) + Jour msgBox Format(Cible, "mmmm") 'une autre possibilité msgBox monthName(Month(Cible))
- Vérifier le paramètre de format Date sur le poste de travail
Sub testParametresDate() msgBox Application.International(xlDateOrder) 'Ordre des éléments de la date: '0 = mois-jour-année '1 = jour-mois-année '2 = année-mois-jour End Sub
Les Spécificités d' Excel sur Macintosh- De nombreuses informations interessantes sur la Wiki Page de Jean-Marie : MacVba
Utiliser la librairie Mingx et Excel pour générer des fichiers Flash ( format .SWF )
Nécéssite d'installer préalablement la DLL Mingx Le lien sur le forum XLD Le fichier zippé Vous trouverez dans le fichier zippé un lien vers le site très bien documenté d'Eric Schrafstetter
Une alternative à Microsoft Office : Open OfficeSi vous constatez des erreurs dans la page n'hesitez pas à m'en faire part .
Toutes vos idees sont les bienvenues .
 Michel , Mise à jour le 25 Novembre 2006
Dernière modification par MichelXld 08/03/2008 à 22h41.
|
08/03/2008, 17h37
Discussions similaires
