|
XLDnaute Barbatruc
Date d'inscription: février 2005
Messages: 3 648
|
[REF] Wiki Page 1 de MichelXld
Les sujets abordés dans cette page :
- 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 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 feuilles Excel- Quelques exemples d'actions VBA sur les feuilles
Ajouter une feuille Renommer la feuille active Supprimer une feuille Trier les onglets par ordre alphabetique Protéger er déproteger une feuillle par macro Le lien sur le forum XLD Le fichier zippé
- Les différences entre Sheets et Worksheets
Worksheets ne prend en compte que les feuilles (xlWorksheet) Sheets prend en compte tous les types d'onglets : xlWorksheet xlChart xlExcel4MacroSheet xlExcel4IntlMacroSheet Un exemple qui liste les feuilles du classeur et indique leur type Sub listerTypesFeuillesClasseur() Dim i As Integer, j As Integer Dim typeFeuilles As String Dim Ch As Chart Dim Cible As Boolean For i = 1 To Sheets.Count j = Sheets(i).Type typeFeuilles = typeFeuilles & Sheets(i).Name & " : " Cible = False For Each Ch In Charts If Ch.Name = Sheets(i).Name Then Cible = True Next Ch If Cible = True Then typeFeuilles = typeFeuilles & " Feuille graphique" Else Select Case j Case xlWorksheet typeFeuilles = typeFeuilles & " xlWorksheet" Case xlChart typeFeuilles = typeFeuilles & " xlChart" Case xlExcel4MacroSheet typeFeuilles = typeFeuilles & " xlExcel4MacroSheet" Case xlExcel4IntlMacroSheet typeFeuilles = typeFeuilles & " xlExcel4IntlMacroSheet" End Select End If typeFeuilles = typeFeuilles & vbLf Next i msgBox typeFeuilles End Sub
- Sélectionner la dernière page du classeur
Worksheets(Worksheets.Count).Select
- Supprimer la premiere feuille du classeur
Worksheets(1).Delete Un autre exemple qui permet de choisir la ou les feuilles à supprimer depuis une Listbox Le lien sur le forum XLD
- Masquer les onglets
activewindow.displayworkbookTabs = False
- Afficher les onglets
activewindow.displayworkbookTabs = True
- Ajouter une nouvelle feuille , la positionner à la fin du classeur et la renommer
Sub nouvellefeuille() Worksheets.Add After:=Sheets(Sheets.Count) activesheet.Name = ("XLD") End Sub
- Copier une feuille nommée "Feuil1", la positionner à la fin du classeur et la renommer
Sub copierFeuilleDansClasseur() Sheets("Feuil1").Copy After:=Worksheets(Sheets.Count) activeSheet.Name = "Nouvelle Feuille" End Sub
- Correspondance entre le numéro de colonne et la lettre de l'entete de colonne
Sub lettresnumeroColonne() Dim boucle As Integer, valeur As Integer, Z As Integer boucle = activeCell.Column If boucle <= 26 Then msgbox Chr(Boucle + 64) Else Valeur = application.rounddown(Boucle / 26, 0) If Valeur = Boucle / 26 Then Valeur = Valeur - 1 Z = (Boucle - (26 * Valeur)) + 64 msgbox Chr(Valeur + 64) & Chr(Z) End If End Sub
- Lister les feuilles du classeur et créer un lien vers chacune d'entre elles
Sub creerLiensAutresFeuilles() Dim I As Byte, J As Byte Dim Valeur As String For I = 1 To Sheets.Count If Not activeSheet.Name = Sheets(I).Name Then Valeur = "'" & Sheets(I).Name & "'!A1" J = J + 1 Worksheets(1).Hyperlinks.Add Anchor:=Cells(J, 1), Address:="", subAddress:=Valeur End If Next I End Sub
- Un exemple de boucle sur toutes les feuilles du classeur actif
Sub boucleSurLesFeuilles() Dim Ws As Worksheet For Each Ws In activeWorkbook.Sheets msgBox Ws.Name Next Ws End Sub
- Insérer des informations en pied de page
Le lien sur le forum XLD Un autre exemple : insérer le chemin complet du classeur en pied de page Le lien sur le forum XLD A partir d'Excel2002 , il est possible d'insérer cette information dans les entetes et pied de page sans macro Pour personnaliser le format du pied de page (police , gras , taille 20 et souligné) : Feuil1.pageSetup.leftFooter = "&""Arial,Gras""&20&U" & "Le forum XLD"
- Insérer une image dans l'entête de page , de la feuille active
Le lien sur le forum XLD
- Insérer des sous totaux à chaque saut de page
Le lien sur le forum XLD
- Retrouver un mot de passe oublié : Déprotection de la feuille active
Le lien sur le forum XLD Deux autres solutions proposées par myDearFriend et michel_M Le lien sur le forum XLD
- Limiter la possibilité de déplacement à la plage A1:E50 , dans la feuille active
Sub deplacementDansCellules() activeSheet.scrollArea = "A1:E50" End Sub et pour supprimer la limitation de déplacement Sub annulerLimitationDeplacement() activeSheet.scrollArea = "" End Sub
- Compter le nombre d'onglets sélectionnés dans le classeur actif
msgBox thisWorkbook.Windows(1).selectedSheets.Count
- Récuperer la valeur du zoom de la fenetre active
Sub valeurZoom() msgBox activeWindow.Zoom End Sub
- Zoomer rapidement dans la feuille.
1. Sélectionnez une cellule 2. Maintenez enfoncée la touche Ctrl et utilisez la molette de la souris
- Supprimer toutes les feuilles vides du classeur
Sub supprimerFeuillesVides() Dim Ws As Worksheet For Each Ws In thisWorkbook.Sheets If Ws.usedRange.Cells.Address = "$A$1" And _ isEmpty(Ws.Range("A1")) And Ws.Shapes.Count = 0 Then Application.displayAlerts = False Ws.Delete Application.displayAlerts = True End If Next Ws End Sub
- Protéger ou déprotéger toutes les feuilles du classeur
Le lien sur le forum XLD
- Insérer une colonne à l'emplacement de la colonne B
Columns("B:B").Insert
- Insérer un saut de page avant la 25eme ligne de la feuille active
activeSheet.HPageBreaks.Add Before:=Cells(25, 1)
- Créer des sauts de page toutes les 10 lignes , jusqu'à la ligne 50
Sub sautDePageAutomatique() Dim i As Integer For i = 11 To 51 Step 10 Feuil1.HPageBreaks.Add Before:=Cells(i, 1) Next i End Sub
- Activer l'aperçu des sauts de page
activeWindow.View = xlPageBreakPreview
- Desactiver l'aperçu des sauts de page
activeWindow.View = xlNormalView
- Appliquer une Couleur jaune à l'onglet de la Feuil1 (fonctionne uniquement à partir d'Excel2002)
Sheets("Feuil1").Tab.colorIndex = 6
- Regrouper les données de toutes les feuilles dans un onglet unique
Sub compilationFeuilles() Dim Wb As Workbook Dim Ws As Worksheet Dim i As Byte Dim Ligne As Integer Set Wb = Workbooks.Add(1) 'creation d'un nouveau classeur On Error Resume Next For i = 1 To thisWorkbook.Sheets.Count 'boucler sur les feuilles du classeur Set Ws = thisWorkbook.Sheets(i) Ws.usedRange.Cells.Copy Ligne = _ Wb.Sheets("Feuil1").Cells.Find("*", Wb.Sheets("Feuil1").Range("A1"), _ searchDirection:=xlPrevious).Row + 1 If Ligne = 0 Then Ligne = 1 Wb.Sheets("Feuil1").Cells(Ligne, 1).Select Wb.Sheets("Feuil1").Paste Next i End Sub
- Créer une animation dans la feuille ( une demo tres interessante de Didier pour son 200eme post )
Le lien sur le forum XLD Le fichier zippé
- Supprimer la ligne complete si les cellules sont vides dans la colonne F
Sub supprimerLignesV02() Dim i As Integer, j As Integer 'derniere cellule non vide dans la colonne F j = Range("F65536").End(xlUp).Row Application.screenUpdating = False For i = j To 1 Step -1 If Cells(i, 6) = "" Then Rows(i).Delete Next i Application.screenUpdating = True End Sub
- Copier quelques feuilles dans un nouveau classeur
Sheets(Array("Feuil1", "Feuil3")).Copy
- Supprimer les lignes , si les cellules de la colonne A contiennent une erreur type #N/A
Sub suppressionLigne_siErreur_NA() Dim C As Integer For C = 5000 To 1 Step -1 If worksheetFunction.isErr(Range("A" & C)) = True Then If CVErr(xlErrNA) = Range("A" & C) Then Rows(C).entireRow.Delete End If Next C End Sub
- Controler l'existence de la feuille "nameSheet" dans le classeur
Sub controlePresenceFeuille() Dim Ws As Worksheet On Error Resume Next Set Ws = thisWorkbook.Sheets("nameSheet") If Ws Is Nothing Then msgBox "La feuille n'existe pas" End Sub
- Créer une liste de recopie personnalisée par macro
L'équivalent de : Menu Outils Options Onglet "Listes pers." Application.addCustomList Array("Blanc", "Vert", "Rouge", "Bleu", "Noir") Si les données sont dans une plage de cellules , utilisez : Application.addCustomList Range("A1:A10") Désormais , lorsque vous saisissez une de ces données dans une cellule et utilisez la poignée de recopie , la liste est automatiquement créée dans la feuille . Informations complémentaires issues de l'aide en ligne Excel : Le dernier Argument byRow (facultatif) )est utilisé uniquement si la valeur de l'argument listArray est un objet Range. Affectez-lui la valeur True pour créer une liste personnalisée à partir de chacune des lignes contenues dans la plage. Affectez-lui la valeur False pour créer une liste personnalisée à partir de chacune des colonnes située dans la plage. Si vous ne spécifiez pas cet argument et que le nombre de lignes est supérieur ou égal au nombre de colonnes de la plage, Microsoft Excel crée une liste personnalisée à partir de chacune des colonnes de la plage. En revanche, si vous ne spécifiez pas cet argument et que le nombre de colonnes est supérieur au nombre de lignes, Microsoft Excel crée une liste personnalisée à partir de chacune des lignes de la plage.
Les graphiques- Changer les etiquettes dans un graphique en nuage de points
Le lien sur le forum XLD Le fichier zippé Un autre exemple Le lien sur le forum XLD Le fichier zippé
- Changer la position et la taille des graphiques dans une feuille
Le lien sur le forum XLD Le fichier zippé
- Selectionner les cellules par Application.inputbox puis Inserer une nouvelle courbe
Le lien sur le forum XLD Le fichier zippé
- Adapter la position d'un graphique par rapports aux sauts de page
Le lien sur le forum XLD Le fichier zippé
- Graphique dans userform
Le lien sur le forum XLD Le fichier zippé
- Gerer plusieurs séries
Le lien sur le forum XLD Le fichier zippé
- Afficher la plage de données en abscisses , d'un graphique
Sub plageDonneesAbscisses() Dim Cible As String, Debut As String activeSheet.chartObjects("graphique 1").Activate'adapter selon nom graphique Cible = activeChart.seriesCollection(1).Formula Debut = Right(Cible, Len(Cible) - inStr(1, Cible, ",")) msgBox "La plage en Abscisses est : " & Left(Debut, inStr(1, Debut, ",") - 1) End Sub
- Extraire les plages de données (Ordonnées et Abscisses) de la premiere série d'un graphique
Sub extrairePlageDonnesGraphique() 'cet exemple ne fonctionne pas si la plage d'abscisses n'est pas précisée dans le graphique Dim Cible As String, Abscisse As String, Ordonnee As String Cible = activeSheet.chartObjects(1).Chart.seriesCollection (1).Formula Abscisse = Right(Cible, Len(Cible) - inStr(1, Cible, ",")) Abscisse = Left(Abscisse, inStr(1, Abscisse, ",") - 1) Abscisse = Right(Abscisse, Len(Abscisse) - inStr(1, Abscisse, "!") - 1) msgBox "Plage abscisses : " & Abscisse Ordonnee = Right(Cible, Len(Cible) - (inStr(1, Cible, Abscisse) + Len(Abscisse))) Ordonnee = Left(Ordonnee, inStr(1, Ordonnee, ",") - 1) Ordonnee = Right(Ordonnee, Len(Ordonnee) - inStr(1, Ordonnee, "!") - 1) msgBox "Plage ordonnées : " & Ordonnee End Sub
- Récupérer la valeur du 2eme point , dans la 1ere serie d'un graphique nommé "Graphique 1"
Sub pointsGraph() Dim Valeur As Single With Sheets("Feuil1").chartObjects("Graphique 1").Chart.seriesCollection(1).Points(2) .hasDataLabel = True 'affiche la valeur du point dans le graphique Valeur = .dataLabel.Characters.Text 'recupere la valeur du point dans une variable .hasDataLabel = False 'ne plus afficher la valeur du point End With msgBox Valeur End Sub
- Se déplacer dans la feuille et avoir le graphique toujours apparent
Le lien sur le forum XLD Le fichier zippé
- Supprimer un graphique
Sub supprimeGraphique() Dim graph As Object Set graph = activeSheet.chartObjects(1) graph.Delete Set graph = Nothing End Sub
- Supprimer tous les graphiques de la feuille active
activeSheet.chartObjects.Delete
- Adapter la position d'un graphique sur une plage de Cellules A20:G40
Sub positionGraph() With activeSheet.chartObjects(1) .Left = Range("A20:G40").Left .Top = Range("A20:G40").Top .Width = Range("A20:G40").Width .Height = Range("A20:G40").Height End With End Sub
- Choisir la courbe à afficher depuis un combobox
Le lien sur le forum XLD Le fichier zippé
- Choisir dans une Listbox parmi plusieurs courbes, avec une option pour préciser la période d'affichage des données
Le fichier zippé
- Compter le nombre de graphiques dans la feuille active
msgBox activeSheet.chartObjects.Count
- Créer un graphique et le renommer
Le lien sur le forum XLD
- Utiliser un tableau Array pour définir les abscisses de la 1ere série du graphique actif
Activechart.seriesCollection(1).XValues = Array(5, 7,9,11,13,15)
- Création d'un graphique à partir de tableaux Array
Sub creationGraphiqueTableauxArray() Charts.Add activeChart.Location Where:=xlLocationAsObject, Name:="Feuil1" With activeChart .seriesCollection.newSeries .seriesCollection(1).XValues = Array("A", "B", "C", "D") .seriesCollection(1).Values = Array(100, 250, 200, 270) .seriesCollection(1).Name = "nomGraphique" .chartType = xlColumnClustered .hasLegend = False .chartTitle.Text = "Le titre" .Deselect End With End Sub
- Création d'un graphique à partir de tableaux dynamiques
Sub creationGraphiqueParTableau() Dim i As Byte Dim Tableau(10) As Integer, Tableau2(10) As Integer For i = 1 To 10 'tableau abscsisses Tableau(i) = i * 2 Next i For i = 1 To 10 'tableau ordonnées Tableau2(i) = Int((50 * Rnd) + 1) Next i Charts.Add activeChart.Location _ Where:=xlLocationAsObject, Name:="Feuil1" With activeChart .seriesCollection.newSeries .seriesCollection(1).XValues = Tableau() .seriesCollection(1).Values = Tableau2() .chartType = xlLine End With End Sub
- Redéfinir l'abscisse d'un graphique a partir un tableau dynamique
Option Base 1 Sub abscissesParTableau() Dim i As Byte Dim Tableau(10) For i = 1 To 10 'tableau pour les abscsisses Tableau(i) = i * 2 Next i activeChart.seriesCollection(1).XValues = Tableau() End Sub
- Construire un graphique avec des series a la fois en courbe et en colonnes
si vous avez par exemple plusieurs series de données au format courbe dans un graph , vous pouvez effectuer un clic droit sur une de ces series , dans le menu déroulant choisir l'option type de graphique , et vous pouvez alors sélectionner le format souhaité : colonne Exemple pour affecter par macro un format particulier( Line) à la 2eme serie d'un graphique : activeChart.seriesCollection(2).chartType = xlLine
- Modifier les couleurs d'un graphique en secteur , en fonction des étiquettes
Le lien sur le forum XLD
- Exporter les graphiques au format Gif et les donnees de chaque série dans des fichiers texte
cette procédure permet d'enregistrer dans le meme repertoire que le classeur : chaque graphique au format .gif et chaque serie de donnees dans un fichier texte (dans cet exemple chaque graphique ne contient qu'une serie de données ) Sub extractionGraphiquesEtDonnees() 'http://www.excel-downloads.com/component/option,com_simpleboard/Itemid,40/func,view/catid,2/id,3094/#3094 Dim Cible As chartObject Dim i As Byte Dim valeur As Double For Each Cible In Feuil1.chartObjects Cible.Chart.Export Filename:=thisWorkbook.Path & "\" & Cible.Name _ & ".gif", filtername:="GIF" 'export au format gif Open thisWorkbook.Path & "\" & Cible.Name & ".txt" For Append As #1 For i = 1 To Cible.Chart.seriesCollection(1).Points.Count With Cible.Chart.seriesCollection(1).Points(i) .hasDataLabel = True 'affiche la valeur du point dans le graphique valeur = .dataLabel.Characters.Text 'recupere la valeur du point dans une variable .hasDataLabel = False 'ne plus afficher la valeur du point End With Print #1, valeur 'enregistrement dans fichier texte Next i Close #1 Next End Sub
- Copier un graphique dans une autre feuille et lui attribuer le meme nom
Le lien sur le forum XLD
- Animer un graphique
Le lien sur le forum XLD La démo de Didier myDearFriend La démo de Jean Marie
- Lister tous les graphiques d'un classeur
Le lien sur le forum XLD Le fichier zippé
- Savoir si un Graphique est issu d'un TCD ( renvoie Vrai ou Faux )
msgBox Sheets("Graph1").hasPivotFields
- Ne pas imprimer un graphique
Faites un clic droit sur le graphique Sélectionnez "format de la zone graphique" Sélectionnez l'onglet "propriétés" Décochez "imprimer l'objet" Cliquez sur OK pour valider par macro Feuil1.drawingObjects("Graphique 1").printObject = False
- Imprimer le 2eme graphique contenu dans le Feuil1
Feuil1.chartObjects(2).Chart.printOut
- Définir la plage des abscisses dans le graphique actif
Dim Plage As Range Set Plage = Feuil1.Range("A1:A10") activeChart.seriesCollection(1).XValues = Plage
- Ajouter un titre dans le graphique
With Sheets(1).chartObjects(1).Chart .hasTitle = True .chartTitle.Characters.Text = "XLD" End With
- Récupérer le titre du graphique
msgBox Sheets(1).chartObjects(1).Chart.chartTitle.Charact ers.Text
- Ajouter une droite verticale dans un graphique en barre
Le fichier zippé
- Modifier le nombre d'abscisses entre les étiquettes de graduation
Double clic sur l'axe des abscisses du graphique Sélectionnes l'onglet Echelle Modifies la valeur dans le champ "nombre d'abscisses entre les étiquettes de graduation" Cliques que OK pour valider
- Créer un second axe d'ordonnées dans un graphique
Sélectionnes dans le graphique la courbe qui va servir à appliquer l'axe secondaire Clic droit Choisis l'option "format de la série de données" Onglet "Sélection de l'axe" Choisis l'option "Axe secondaire" Cliques sur OK pour valider
- Afficher l'écart entre deux valeurs dans un graphique
Thanks Andy and Celeda Le lien sur le forum XLD Le fichier zippé
- Des bulles et des nuages de points dans un meme graphique
Le lien sur le forum XLD Le fichier zippé
- Afficher une droite d'équation dans un graphique à bulles (une démo de Myta)
Le lien sur le forum XLD Le fichier zippé
- Afficher en étiquette uniquement le premier et le dernier point d'une serie
Clic droit sur le premier point de la courbe ( les autres points ne doivent pas etre sélectionnés ) Format de données onglet "Etiquette de données" coches l'option "Valeur" Cliques sur OK pour valider ensuite tu fais le meme chose pour le dernier point de la serie
- Récupérer l'équation d'une courbe de tendance
Sub equationsCourbeDeTendance() Dim Equation As String With Feuil1.chartObjects(1).Chart.seriesCollection(1).T rendlines(1) .displayRSquared = False .displayEquation = True Equation = .dataLabel.Text End With msgBox Equation End Sub
- Récupérer la couleur d'arrière-plan de la premiere serie d'un graphique en nuage de points
msgBox activeChart.seriesCollection(1).markerBackgroundCo lorIndex
- Récupérer la couleur d'arrière-plan du 2eme point dans la premiere serie d'un graphique en nuage de points
msgBox activeChart.seriesCollection(1).Points(2).markerBa ckgroundColorIndex
- Modifier la couleur d'arrière-plan du 2eme point dans la premiere serie d'un graphique en nuage de points
activeChart.seriesCollection(1).Points(2).markerBa ckgroundColorIndex = 4 'Vert
- Transformer une feuille graphique "Graph1" en objet dans la feuille "Feuil1"
Charts("Graph1").Location Where:=xlLocationAsObject, Name:="Feuil1"
- Les spécifications et limites relatives aux graphiques (Excel2002)
Feuilles de calcul auxquelles il est fait référence dans un graphique : 255 Nombre maximal de séries de données par graphique : 255 Nombre de caracteres dans la barre de formules : 255 Nombre maximal de points de données par série dans les graphiques 2D : 32 000 Points de données par série de données pour les graphiques 3D : 4 000 Points de données pour toutes les séries de données d'un graphique : 256 000 Styles de lignes : 8 Epaisseurs de ligne : 4 Motifs en aires (affichage écran) : 18 Total de combinaisons de motifs et de couleurs (affichage couleur) : 56 448 Combinaisons de motifs et de couleurs (impression couleur) : 56 448 (le nombre réel dépend de votre imprimante et de son logiciel) Nombre maximal de champs de page (dans un rapport de tableau ou de graphique croisé dynamique.) : 256 (limitation possible en fonction de la quantité de mémoire disponible) Nombre maximal de champs de données par rapport de tableau croisé dynamique : 256 Formules d'élément calculées dans un rapport de graphique croisé dynamique : Limité par la quantité de mémoire disponible
- Faire clignoter une série dans un graphique : une démo de Jean Marie
Le lien sur le forum XLD Le fichier zippé
- Appliquer des couleurs différentes pour les valeurs négatives ou positives , dans un graphique en barre
Sélectionnes la série dans le graphique Clic droit Format de la série de données Coches l'option "inversée si négative" cliques sur OK pour valider
- Masquer les étiquettes de données à 0 au dessus des histogrammes : une solution de Jean Marie
Le lien sur le forum XLD
- Enlever la couleur dans la zone de traçage
activeChart.plotArea.Interior.colorIndex = xlNone
- Gérer les cellules vides dans la plage de données d'un graphique
Sélectionnes le graphique Menu Outils Options Onglet "Graphique" Choisis une des options : non tracées, valeur zéro , interpolées Cliques sur OK pour valider
- Afficher les étiquettes d'un graphique et préciser leur position
Sub differentesPositionsLabelDansGraphique() 'exemple avec graphique type Histogramme With Feuil1.chartObjects(1).Chart.seriesCollection(1) .hasDataLabels = True '.dataLabels.Position = xlLabelPositionInsideBase 'Affichage dans la barre(en bas) '.dataLabels.Position = xlLabelPositionOutsideEnd 'Affichage au dessus de chaque barre '.dataLabels.Position = xlLabelPositionInsideEnd 'Affichage dans la barre(en haut) .dataLabels.Position = xlLabelPositionCenter 'Affichage dans la barre(centrée) End With End Sub Les constantes utilisables : xlLabelPositionAbove xlLabelPositionBestFit xlLabelPositionCustom xlLabelPositionInsideEnd xlLabelPositionMixed xlLabelPositionRight xlLabelPositionBelow xlLabelPositionCenter xlLabelPositionInsideBase xlLabelPositionLeft xlLabelPositionOutsideEnd Remarque : Certaines constantes sont inopérantes selon le type de graphique utilisé
- Effacer les données du graphique mais laisser la mise en forme intacte
Feuil1.chartObjects(1).Chart.chartArea.clearConten ts
- Les evenements dans la feuille graphique
L'activation du graphique Private Sub Chart_Activate() Le double clic dans le graphique
Private Sub Chart_beforeDoubleClick(byVal ElementID As Long, byVal Arg1 As Long, byVal Arg2 As Long, Cancel As Boolean) Un exemple pour empecher l'affichage de la boite de dialogue "Format de zone de traçage" lors d'un double clic Private Sub Chart_beforeDoubleClick(byVal ElementID As Long, byVal Arg1 As Long, byVal Arg2 As Long, Cancel As Boolean) Cancel = True End Sub L'argument ElementID correspond à l'objet sur lequel tu cliques. Les Arguments Args1 et Args dépendent de l'objet cliqué Consultez l'aide MSDN pour plus d'informations Le clic droit dans un graphique
Private Sub Chart_beforeRightClick(Cancel As Boolean) Pour ne pas afficher le menu contextuel lors d'un clic droit Private Sub Chart_beforeRightClick(Cancel As Boolean) Cancel = True End Sub La mise à jour du graphique
Private Sub Chart_Calculate() Comme les mises en forme personnalisées des graphiques croisés dynamiques ne sont pas conservées lors des réactualisations de données , cet evenement peut etre interessant pour forcer une mise en forme Un exemple pour que la 1ere série du graphique soit toujours de couleur rouge Private Sub Chart_Calculate() activeChart.seriesCollection(1).Border.colorIndex = 3 End Sub La désactivation du graphique
Private Sub Chart_Deactivate() Les mouvements de la souris dans un graphique
Private Sub Chart_mouseDown(byVal Button As Long, byVal Shift As Long, byVal x As Long, byVal y As Long) Private Sub Chart_mouseMove(byVal Button As Long, byVal Shift As Long, byVal x As Long, byVal y As Long) Private Sub Chart_mouseUp(byVal Button As Long, byVal Shift As Long, byVal x As Long, byVal y As Long) La selection d'un objet dans le graphique
Private Sub Chart_Select(byVal ElementID As Long, byVal Arg1 As Long, byVal Arg2 As Long) L'argument ElementID correspond à l'objet sur lequel tu cliques , les Arguments Args1 et Args dépendent de l'objet cliqué La modification des valeurs dans les séries
Private Sub Chart_seriesChange(byVal seriesIndex As Long, byVal pointIndex As Long) Remarque :
Pour gérer les evenements d'un graphique incorporé dans la feuile de calcul , il faut utiliser des modules de classe . D'autres informations complémentaires Le lien sur Internet
- Vérifier si un graphique nommé "Graphique 1" existe dans la Feuil2
Dim Grph As chartObject On Error Resume Next Set Grph = Sheets("Feuil2").chartObjects("Graphique 1") If Not Grph Is Nothing Then msgBox "Graphique trouvé"
- Créer un graphique en utilisant l'utilitaire d'analyse VBA
'Source :http://support.microsoft.com/default.aspx?scid=kb;en-us;270844&Product=vbb#top 'Les données numériques sont dans la Feuil1 en A1:A10 et B1:B4 Dim Ws As Worksheet Set Ws = thisWorkbook.Worksheets("Feuil1") 'L'utilitaire d'analyse-VBA doit etre prélablement activé 'Menu Outils 'Macros complémentaires 'Cochez la ligne "Utilitaire d'analyse-VBA" 'Cliquez sur OK pour valider Application.Run "ATPVBAEN.XLA!Histogram", Ws.Range("$A$1:$A$10"), _ "", Ws.Range("$B$1:$B$4"), False, False, True, False
- Empecher le copier/coller d'une feuille graphique
Celle procedure evenementielle doit etre placée au niveau du classeur (thisWorkbook) Private Sub Workbook_sheetDeactivate(byVal Sh As Object) Dim Ch As Chart For Each Ch In Charts If Ch.Name = Sh.Name Then Application.cutCopyMode = False Next Ch End Sub Une autre solution en utilisant l'evenement Deactivate de la feuille graphique Private Sub Chart_Deactivate() Application.cutCopyMode = False%%%% End Sub
- Déterminer la valeur d'abscisse au croisement entre 2 courbes d'un graphique
=(ORDONNEE.ORIGINE(A1:A2;C1:C2)-ORDONNEE.ORIGINE(B1:B2;C1:C2))/(PENTE(B1:B2;C1:C2)-PENTE(A1:A2;C1:C2)) Les ordonnées Y sont dans les colonnes A et B Les abscisses X sont dans la colonne C
- Créer un graphique et afficher les points de la série progressivement
Sub afficherPointsGraphiqueProgressivement() Dim j As Integer Dim Plage As Range Dim t As Long Charts.Add activeChart.chartType = xlXYScatter 'les données sont dans la plage B2:B20 activeChart.seriesCollection.Add Worksheets("Feuil1").Range("B2:B20") activeChart.seriesCollection(1).markerBackgroundCo lorIndex = _ activeChart.plotArea.Interior.colorIndex activeChart.seriesCollection(1).markerForegroundCo lorIndex = _ activeChart.plotArea.Interior.colorIndex For j = 2 To 20 t = Timer + 1: Do Until Timer > t: doEvents: Loop ' 1 seconde activeChart.seriesCollection(1).Points(j - 1).markerBackgroundColorIndex = 3 doEvents Next j End Sub
- Utiliser un timer pour faire défiler des valeurs dans un graphique .
Le lien sur le forum XLD Le fichier zippé
- Créer un graphique en utilisant une plage de données dynamique .
Cet exemple permet de redimensionner automatiquement les plages de données sources dans le graphique , lorsque vous ajoutez ou supprimez des valeurs dans le tableau . Le fichier zippé Un autre exemple qui prend en compte uniquement les 8 dernieres valeurs de la base de données et qui s'actualise automatiquement lors de l'ajout ou la suppression d'enregistrements Le fichier zippé
- Afficher dans les labels l'évolution des valeurs d'une série en fonction du point précédent .
Sub afficherEvolutionPourcentage_enFonctionDuPointPrec edent() 'remarque : les labels ne seront pas mis à jour automatiquement 'si les données sont modifiées dans le tableau Dim j As Integer Dim X As Single, Y As Single Dim Resultat As String On Error Resume Next 'suppression des Labels existants Feuil1.chartObjects(1).Chart.seriesCollection(1).d ataLabels.Delete On Error goTo 0 'affichage des Labels (Ordonnées) pour en extraire les valeurs Feuil1.chartObjects(1).Chart.seriesCollection(1).a pplyDataLabels Type:=xlDataLabelsShowValue 'boucler sur les point de la 1ere serie ( en dehors du premier point ) For j = 2 To Feuil1.chartObjects(1).Chart.seriesCollection(1).P oints.Count X = Feuil1.chartObjects(1).Chart.seriesCollection(1).P oints(j).dataLabel.Characters.Text 'valeur du point Y = Feuil1.chartObjects(1).Chart.seriesCollection(1).P oints(j - 1).dataLabel.Characters.Text 'valeur du point precedent 'insere le pourcentage pour chaque point de la serie 'cette ligne est placée avant la ligne "Resultat = Format((X / Y) - 1, "0.00%")" et permet ainsi 'de ne rien afficher pour le 1er point Feuil1.chartObjects(1).Chart.seriesCollection(1).P oints(j - 1).dataLabel.Characters.Text = Resultat 'calcul le pourcentage entre le point et le point de la semaine precedente Resultat = Format((X / Y) - 1, "0.00%") Next j 'affiche le pourcentage pour le dernier point de la serie Feuil1.chartObjects(1).Chart.seriesCollection(1).P oints(j - 1).dataLabel.Characters.Text = Resultat End Sub
- Changer la taille des caracteres dans un graphique
activeSheet.chartObjects("Graphique 1").Chart.chartArea.Font.Size = 8
- Créer et Afficher une graphique dans une fenetre popup Internet Explorer
Dim nomImage As String Dim IE As Object Dim Hauteur As Single, Largeur As Single nomImage = "C:\imageTemp.gif" If Dir(nomImage) <> "" Then Kill nomImage 'supprime l'image si elle existe déjà Application.screenUpdating = False Charts.Add With activeChart .chartType = xlLineMarkers .setSourceData Source:=Sheets("Feuil1").Range("A1:B5"), plotBy:=xlColumns .Location Where:=xlLocationAsObject, Name:="Feuil1" End With With activeChart .hasTitle = True .chartTitle.Characters.Text = "le graphique" .hasLegend = True .Legend.Position = xlLegendPositionRight End With activeChart.Export nomImage, "GIF" 'export du graphique au format image Hauteur = Feuil1.chartObjects(Feuil1.chartObjects.Count).Hei ght * 1.8 Largeur = Feuil1.chartObjects(Feuil1.chartObjects.Count).Wid th * 1.6 Sheets("Feuil1").chartObjects(Sheets("Feuil1").cha rtObjects.Count).Delete Application.screenUpdating = True 'creation d'une fenetre internet explorer pour visualiser l'image du graphique Set IE = createObject("internetExplorer.application") IE.navigate "about:blank" IE.document.Title = "mon graphique" IE.addressbar = False IE.menuBar = False IE.statusBar = False IE.Toolbar = False IE.Width = Largeur IE.Height = Hauteur IE.Left = 120 IE.document.body.innerHTML = "<html><IMG SRC='" & nomImage & "'</html>" IE.Visible = True
- Créer une ligne de repère dans une graphique dynamique (une solution donnée par Chris)
De façon générale sur les graphiques, il suffit d'ajouter une série de données en type courbe et de donner la même valeur aux données (celle correspondant à la position sur l'axe). Il faut autant de données dans cette série que dans les autres séries du graphiques. Cela crée un graphique combiné : Excel ne combine que les types 2D.
- Supprimer des séries par macro, dont certaines sont vides
Dim W As Worksheet Dim NBSeries As Integer, I As Integer Set W = Worksheets(1) W.chartObjects(1).Activate NBSeries = activeChart.seriesCollection.Count activeChart.displayBlanksAs = xlZero 'équivalent de:Menu Options /onglet Graphique/sélection de l'option "valeur zero" For I = NBSeries To 1 Step -1 activeChart.seriesCollection(I).Delete Next I 'adaptez la réinitialisation en fonction de la valeur par defaut dans le menu d'Options activeChart.displayBlanksAs = xlNotPlotted En résumé pour que cela fonctionne : dans le menu Options Onglet Graphique L'option "Valeurs zero" doit etre sélectionnée dans la zone "traitement des cellules vides" (activeChart.displayBlanksAs = xlZero, par macro)
- Afficher le type du graphique actif
Visualiser la macro
Les imagesUne autre solution beaucoup plus simple (sans enregistrement sur le disque)
Sub insereImage() activeSheet.Pictures. _ Insert("http://www.excel-downloads.com/images/titres/logoED.gif").Select End Sub - Extraire toutes les images d'une feuille
Sub extraireImagesFeuille() Dim Pict As Picture Dim nb As Byte Application.screenUpdating = False For Each Pict In worksheets("Feuil1").Pictures Pict.copyPicture ' copier image With activeSheet.chartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart .Paste 'coller l'image dans graphique .Export thisWorkbook.Path & "\" & Pict.Name & ".gif", "GIF" End With nb = activeSheet.chartObjects.Count activeSheet.chartObjects(nb).Delete Next Pict Application.screenUpdating = True End Sub
- Créer l'image d'une plage de cellule et nommer l'objet
Sub imagePlageCellules() Range("A1:B5").copyPicture ' La plage de cellules A1:B5 est copiée dans le Presse-papiers en tant qu'image activeSheet.Paste ' L'image est collée dans la feuille Selection.Name = "Mon image" ' renomme l'objet End Sub
- Exporter une feuille complete en image , au format JPG
Sub exporter_Feuille_imageJPG() 'http://www.excel-downloads.com/component/option,com_simpleboard/Itemid,40/func,view/catid,2/id,10009/#10009 Dim Ligne As Integer, Colonne As Integer Application.screenUpdating = False Feuil1.usedRange.copyPicture Feuil1.Paste Ligne = Feuil1.Cells.Find("*", Feuil1.Range("A1"), searchDirection:=xlPrevious).Row + 1 Colonne = Feuil1.Cells.Find("*", Feuil1.Range("A1"), searchDirection:=xlPrevious).Column + 1 With Feuil1.chartObjects.Add(0, 0, Cells(Ligne, Colonne).Left, Cells(Ligne, Colonne).Top).Chart .Paste .Export thisWorkbook.Path & "\monImage.jpg", "JPG" End With With Feuil1 .chartObjects(Feuil1.chartObjects.Count).Delete .Shapes(Feuil1.Shapes.Count).Delete End With Application.screenUpdating = True End Sub
- Supprimer toutes les images de la feuille active
Sub suppressionImagesFeuille() activeSheet.Pictures.Delete End Sub
- Une autre solution
Sub supprimerImagesFeuille() Dim Sh As Shape For Each Sh In Worksheets("Feuil1").Shapes If Sh.Type = msoPicture Then Sh.Delete Next End Sub
- Gérer une base de données d'images et les fiches d'informations associées
L'exemple permet de visualiser en une fois toutes les images du répertoire Le lien sur le forum XLD Le fichier zippé
- Choisir une image dans un répertoire et afficher ses dimensions
Sub dimensionsImage() 'testé avec Excel2002 & WinXP 'necessite d'activer reference Microsoft Shell Controls and Automation Dim objShell As Shell Dim objFolder As Folder Dim strFileName As folderItem Dim Fichier As String, Cible As String Dim Rep As Integer Fichier = Application.getOpenFilename Rep = 1 Do Until Rep = 0 Cible = Rep: Rep = inStr(Rep + 1, Fichier, "\") Loop Set objShell = createObject("Shell.Application") Set objFolder = objShell.nameSpace(Left(Fichier, Cible - 1)) Set strFileName = objFolder.Items.Item(Right(Fichier, Len(Fichier) - Cible)) msgBox objFolder.getDetailsOf(strFileName, 26) msgBox objFolder.getDetailsOf(strFileName, 27) msgBox objFolder.getDetailsOf(strFileName, 28) End Sub Une autre solution pour récupérer les dimensions d'une image Dim oPict As IPictureDisp Set oPict = loadPicture("C:\Documents and Settings\michel\DSC00076.JPG") msgBox Application.Round((oPict.Height / 26.46), 0) & " x " & Application.Round((oPict.Width / 26.46), 0)
- Avoir une image de fond dans la feuille , lors de l'impression
Le lien sur le forum XLD Le fichier zippé
- Sauvegarder et visualiser des images GIF animées , dans le classeur
Le lien sur le forum XLD Le fichier zippé Un autre exemple qui permet d'afficher une image animée dans la feuille : L'image GIF est "codée" dans l'onglet "Image 1" Lors de l'ouverture du classeur , l'image est créée sur le disque dur "C:\imageTemp.gif" et s'affiche dans la "Feuil1" (utilsation d'un Webbrowser) Lors de la fermeture du classeur l'image "C:\imageTemp.gif" est supprimée Le fichier zippé
- Utiliser la librairie Windows Image Acquisition Automation Library v2.0 depuis Excel
Cette DLL permet de lire les propriétés d'une image et de la modifier . Lien vers la wiki page 11
- Vérifier si un fichier est une image
(Attention: Tous les formats d'image ne sont pas pris en compte) Dim Fichier As String Dim oPict As IPictureDisp Fichier = "C:\Documents and Settings\michel\dossier\nomFichier.jpg" 'Fichier = "C:\Documents and Settings\michel\dossier\nomFichier.xls" On Error Resume Next Set oPict = loadPicture(Fichier) If Err.Number = 0 Then msgBox "Il s'agit d'une image" Else msgBox "Il ne s'agit pas d'une image" End If On Error goTo 0
Les Propriétés du classeur- Les propriétés d'un classeur par la fonction getFile
Sub proprietesclasseur() Dim Cible As Object, Valeur As Object Dim Resultat As String, Fichier As String Fichier = "C:\Classeur2.xls" 'adpater le chemin Set Cible = createObject("Scripting.fileSystemObject") Set Valeur = Cible.getFile(Fichier) Resultat = "Chemin : " & Valeur.parentFolder & Chr(10) & Chr(10) & _ "Nom et chemin fichier : " & Fichier & Chr(10) & Chr(10) & _ "Date creation : " & Valeur.dateCreated & Chr(10) & Chr(10) & _ "Derniere modification : " & Valeur.dateLastModified & Chr(10) & Chr(10) & _ "Taille classeur : " & Valeur.Size & " octets" Msgbox Resultat End Sub
- Lire Ies proprietes d'un classeur en utilisant builtinDocumentProperties
Sub infosClasseurBuiltinDocumentProperties() Dim Valeur As documentProperty Dim R As Byte On Error Resume Next R = 1 For Each Valeur In activeWorkbook.builtinDocumentProperties Cells(R, 1) = Valeur.Name Cells(R, 2) = Valeur.Value R = R + 1 Next End Sub
- Modifier le nom de l'auteur dans les propriétés du classeur , en utilisant builtinDocumentProperties
thisWorkbook.builtinDocumentProperties("Author").V alue = "xld"
- Ajouter une propriété personnalisée dans le classeur actif
Sub ajouterProprietePersonnalisee() activeWorkbook.customDocumentProperties.Add Name:="infoX", _ Type:=msoPropertyTypeNumber, linkToContent:=False, Value:=1965 'Les types de données possibles : 'msoPropertyTypeNumber:Valeurs entieres(si vous insérez 196.4 , c'est 196 qui sera enregistré ) 'msoPropertyTypeFloat:Valeurs numériques 'msoPropertyTypeBoolean: Vrai ou Faux 'msoPropertyTypeDate: Dates et heures 'msoPropertyTypeString :Texte End Sub
- Boucler sur toutes les propriétés personnalisées du classeur actif
Sub bouclerSurToutesLesProprietesPersonnalisees() Dim Cp As documentProperty If activeWorkbook.customDocumentProperties.Count = 0 Then Exit Sub For Each Cp In activeWorkbook.customDocumentProperties msgBox Cp.Name & vbLf & Cp.Value Next Cp End Sub
- Lire une propriété personnalisée spécifique
msgBox activeWorkbook.customDocumentProperties("infoX").V alue
- Modfifier une propriété personnalisee
activeWorkbook.customDocumentProperties("infoX").V alue = 1997
- Supprimer une propriété personnalisée
activeWorkbook.customDocumentProperties("infoX").D elete
- Afficher les propriétés de tous les fichiers d'un répertoire, sans les ouvrir
Sub propriétésFichiers() 'http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx 'Necessite d'activer la reference Microsoft Shell Controls and Automation Dim objShell As Object, strFileName As Object Dim objFolder As Folder Dim Resultat As String Dim i As Byte Set objShell = createObject("Shell.Application") Set objFolder = objShell.nameSpace("C:\Documents and Settings\michel\dossier\excel") 'repertoire cible For Each strFileName In objFolder.Items 'boucle sur tous les elements du repertoire If strFileName.isFolder = False Then 'pour que les sous dosssiers ne soient pas pris en comptes Resultat = "" For i = 0 To 34 Resultat = Resultat & objFolder.getDetailsOf(strFileName, i) & vbLf Next msgBox Resultat End If Next End Sub Un autre exemple Le fichier zippé
- Afficher les propriétés d'un classeur sans l'ouvrir
La procédure utilise la librairie DSO oleDocument Properties Reader 2.0 Si elle n'est pas installée sur ton poste , tu peux la télécharger sur le site Microsoft : http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351 Remarque : Cette librairie fonctionne pour tous les documents Office ( Word , Powerpoint …) Sub lireProprietesClasseur() 'necessite d'activer la reference DSO oleDocument Properties Reader 2.0 'http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351 Dim DSO As DSOFile.oleDocumentProperties Set DSO = New DSOFile.oleDocumentProperties 'le fichier doit etre fermé ! DSO.Open sfilename:="C:\Documents and Settings\michel\dossier\general\excel\leClasseur.x ls" msgBox DSO.summaryProperties.Author & vbLf & DSO.summaryProperties.Comments 'Les autres propriétés: 'applicationName 'Author 'byteCount 'Category 'characterCount 'characterCountWithSpaces 'Comments 'Company 'dateCreated 'dateLastPrinted 'dateLastSaved 'hiddenSlideCount 'Keywords 'lastSavedBy 'lineCount 'Manager 'multimediaClipCount 'noteCount 'pageCount 'paragraphCount 'presentationFormat 'revisionNumber 'sharedDocument 'slideCount 'Subject 'Template 'Title 'totalEditTime 'Version 'wordCount DSO.Close End Sub
- Modifier les propriétés d'un classeur sans l'ouvrir
'exemple pour modifier le champ "commentaire" d'un fichier Sub modifierProprietesClasseur() 'necessite d'activer la reference DSO oleDocument Properties Reader 2.0 Dim DSO As DSOFile.oleDocumentProperties Set DSO = New DSOFile.oleDocumentProperties 'le fichier doit etre fermé ! DSO.Open sfilename:="C:\Documents and Settings\michel\monFichier.xls" DSO.summaryProperties.Comments = "mon nouveau commentaire" DSO.Save DSO.Close End Sub
- Ajouter une propriété personnalisée au classeur sans l'ouvrir
La procédure utilise aussi la librairie DSO oleDocument Properties Reader 2.0 et fonctionne pour les autres types de documents Office Sub ajouterProprietesPersonnalisees() Dim DSO As DSOFile.oleDocumentProperties Set DSO = New DSOFile.oleDocumentProperties 'le fichier doit etre fermé ! DSO.Open sfilename:="C:\Documents and Settings\michel\monfichier.xls" DSO.customProperties.Add "maPropriete", "le forum XLD" DSO.Save DSO.Close End Sub
- Lire une propriété personnalisée sans ouvrir le classeur
Sub lireProprietesPersonnalisees() 'necessite d'activer la reference DSO oleDocument Properties Reader 2.0 'http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351 Dim DSO As DSOFile.oleDocumentProperties Set DSO = New DSOFile.oleDocumentProperties 'le fichier doit etre fermé ! DSO.Open sfilename:="C:\Documents and Settings\michel\dossier\monClasseur.xls" msgBox DSO.customProperties.Item("leNomDeMaProprietePerso nnalisee").Value 'ou ( l'index de la 1ere propriete personnalisée est 0 ) 'msgBox DSO.customProperties.Item(0).Value DSO.Close End Sub
- Passer un classeur en lecture seule , sans l'ouvrir
Sub passerClasseur_lectureSeule() 'necessite d'activer la reference Microsoft Scriping Runtime Dim Fs As fileSystemObject Dim F As File Set Fs = createObject("Scripting.fileSystemObject") Set F = Fs.getFile("C:\classeur1.xls") F.Attributes = F.Attributes + readOnly End Sub
- La fonction fileDateTime
renvoie la date et l'heure de création ou de dernière modification d'un fichier msgBox fileDateTime("C:\monClasseur.xls")
- D'autres informations sur les propriétés des classeurs
Le lien sur Internet
Les sauvegardes- Quelques exemples de sauvegarde par VBA
Le lien sur le forum XLD Le fichier zippé
- Sauvegarder un classeur automatiquement toutes les XX minutes
Le lien sur le forum XLD
- Sauvegarder uniquement la feuille active
Sub enregistrerFeuilleActive() activeSheet.Copy activeWorkbook.saveAs Filename:="C:\Sauvegarde\test.xls" End Sub
- Deux méthodes pour afficher la boite de dialogue Enregistrer Sous
Sub fenetreEnrgistrerSous1() commandBars.findControl(ID:=748).Execute End Sub Sub FenetreEnrgistrerSous2() Application.Dialogs(xlDialogSaveAs).Show End Sub
- Enregistrer une feuille au format htm , puis l'envoyer par mail
Le lien sur le forum XLD
- Incrémentation d'une unité dans le nom des classeurs sauvegardés
Le lien sur le forum XLD
- Bloquer l'utilisation du bouton "enregistrer sous"
Procédure evenementielle à placer au niveau de thisWorkbook . Private Sub Workbook_beforeSave(byVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI = True Then Cancel = True End Sub
Les shapes / Les formes automatiques - Afficher le contenu d'une cellule dans une forme automatique .
Sélectionnez la forme automatique . Ensuite saisissez la référence à la cellule dans la barre de formules : =A1 De la même manière il est possible de faire référence à une cellule d'une autre feuille :
=Feuil2!A1
- Utiliser une forme automatique comme une case à cocher
Le lien sur le forum XLD Le fichier zippé
- Plusieurs shapes qui suivent le curseur de la souris
Le fichier zippé
- Oter toutes les affectations de macros , pour les formes automatiques( et graphiques ) de la Feuil1
Sub enleveOnAction_Macros() Dim Obj As Shape For Each Obj In Feuil1.Shapes Obj.onAction = "" Next End Sub
- Boucler sur 3 formes automatiques dans la feuille active et leur affecter une macro .
Sub boucleFormesAutomatiques_attributionMacro() Dim Tableau() As Variant Dim i As Byte Tableau = Array("Macro1", "Macro2", "Macro3") For i = 1 To 3 If activeSheet.Shapes(i).Type = 1 Then activeSheet.Shapes(i).onAction = Tableau(i - 1) i = i + 1 Next i End Sub
- Associer un lien hypertexte au 1er shape de la feuille active
activeSheet.Hyperlinks.Add Anchor:=activeSheet.Shapes(1), Address:="C:\monClasseur.xls"
- Supprimer toutes les formes automatiques de la feuille active
Dim Obj As Shape For Each Obj In activeSheet.Shapes If Obj.Type = 1 Then Obj.Delete Next Obj
- Ne pas déplacer ou redimensionner la forme automatique avec les cellules
Feuil1.Shapes("Rectangle 1").Placement = xlFreeFloating cette meme opération sans macro: Clic droit sur l'objet Format de la forme automatique onglet "propriétés" selectionnes l'option "ne pas deplacer ou redimensionner avec les cellules" cliques sur OK pour valider
- Récupérer l'adresse des cellules placées sous la 1ere forme automatique de la Feuil1
msgBox Feuil1.Shapes(1).topLeftCell.Address & ":" & Feuil1.Shapes(1).bottomRightCell.Address
- Cliquer sur une forme automatique dont on ne connait pas le nom afin d'en changer la couleur. Une solution proposée par Hervé.
Affectez cette macro à chaque forme automatique de la feuille active. Sub Coloriage_V02() Dim leNom As String leNom = Application.Caller '10 rouge '1 blanc With activeSheet.Shapes(leNom).Fill.foreColor .schemeColor = IIf(.schemeColor = 10, 1, 10) End With End Sub
Aleatoire- Informations générales issues de l'aide en ligne Excel
La fonction Rnd renvoie une valeur inférieure à 1 mais supérieure ou égale à zéro. Quelle que soit la valeur initiale indiquée, la même série de nombres aléatoires est générée à chaque appel de la fonction Rnd, car cette dernière réutilise le nombre aléatoire précédent comme valeur initiale pour le calcul du nombre suivant. Avant d'appeler Rnd, utilisez l'instruction Randomize sans argument pour initialiser le générateur de nombres aléatoires à partir d'une valeur initiale tirée de l'horloge système.
- Permuter les valeurs d'une colonne et de façon aléatoire
Le lien sur le forum XLD Le fichier zippé
- Afficher un nombre aleatoire entre 1 et 6
Sub nombreAleatoireEntre1et6() Randomize 'Initialisation générateur de nombres aléatoires msgBox Int((6 * Rnd) + 1) End Sub
- Afficher une lettre aléatoire entre A et Z
Sub lettreAleatoire() Dim Cible As Byte Randomize 'Initialisation générateur de nombres aléatoires Cible = Int((26 * Rnd) + 1) msgBox Chr(Cible + 64) End Sub
- Insérer une liste de nombres , de 0 à 199 , de façon aléatoire et sans doublons
Des solutions de Robert , Hervé et Phibou Le lien sur le forum XLD
- Afficher un nombre aléatoire dans une plage de valeurs (entre 10 et 15 dans l'exemple )
Sub nombreAleatoireDansPlageValeurs() Dim Mini As Integer, Maxi As Integer Mini = 10 Maxi = 15 Randomize msgBox Int((Maxi - Mini + 1) * Rnd + Mini) End Sub
Les barres d'outils et les barres de menus- Changer un faceID dans une barre menu integree excel
Exemple remplacement ID "Jumelles" par "Oeil" dans Menu Edition Rechercher Sub changeIDMenuRechercher() Application.commandBars("Worksheet Menu Bar").Controls("Edition"). _ Controls("&Rechercher...").faceId = 2174 'oeil End Sub Sub reinitialiserIDMenuRechercher() Application.commandBars("Worksheet Menu Bar").Controls("Edition"). _ Controls("&Rechercher...").faceId = 1849 'jumelles End Sub
- Choisir entre differentes positions pour une barre d'outils personnalisée
Le fichier zippé
- Afficher le menu contextuel par macro ( le menu qui apparait lors du clic droit dans une cellule)
Sub afficherMenuContextuel() Application.commandBars("Cell").showPopup End Sub
- Afficher la barre de statut et y insérer une information
Application.displayStatusBar = True Application.statusBar = "le forum XLD"
- Réinitialiser le menu contextuel
Sub reinitialiserMenuContextuelDisparu() Application.commandBars("cell").Reset End Sub
- Lister les controles contenus dans le menu contextuel
Sub listerControlesMenucontextuel() Dim i As Integer For i = 1 To Application.commandBars("cell").Controls.Count Cells(i, 1) = Application.commandBars("cell").Controls(i).Captio n Next i End Sub
- Masquer la barre de statut
Application.displayStatusBar = False
- Associer un menu personnalisé à un classeur
le nouveau menu est créé lors de l'ouverture du classeur et supprimé lors de la fermeture du classeur Le lien sur le forum XLD Le fichier zippé
- Réafficher une barre d'outils disparue
(exemple de la barre Web ) Sub recupererBarreOutilsDisparue() Application.commandBars("Web").Enabled = True Application.commandBars("Web").Visible = True End Sub Un utilitaire complet pour restaurer les barres d'outils disparues, créé par @+Thierry Le lien sur le forum XLD
- attacher une image à un bouton , dans une barre d'outils personnalisée
Sub imageDansBouton_barreOutilsPersonnalisee() Dim monBouton As commandBarControl Dim Pict As IPictureDisp Application.commandBars.Add(Name:="maBarreOutils") .Visible = True Application.commandBars("maBarreOutils").Controls. Add _ (Type:=msoControlButton).Caption = "testBouton" Set Pict = stdole.stdFunctions.loadPicture("C:\monImage.bmp") Set monBouton = Application.commandBars("maBarreOutils").Controls( "testBouton") With monBouton .Picture = Pict .tooltipText = "essai" .onAction = "maMacro" .Style = msoButtonIconAndCaption End With End Sub
- D'autres exemples pour personnaliser des menus et une barre de menus dans Excel
Le lien vers l'aide en ligne Microsoft
- Créer un commandBarButton contenant un Icone et du Texte
Le lien sur le forum XLD
Les boites de dialogue integrees Excel- Un mini tutorial basique sur les Msgbox , Inputbox et l'assistant animation
Le lien sur le forum XLD Le fichier zippé
- Inputbox : Intercepter l'utilisation du bouton Annuler
Sub Test() Dim Reponse As Variant Reponse = Application.inputBox("Saisissez vos données ", "Message", "le forum XLD") If Reponse = False Then msgBox "Action Annulée" End Sub
- Afficher les boites de dialogues integrees
par exemple afficher la fenetre Enregistrer Sous Sub Lance() Application.Dialogs(xlDialogSaveAs).Show End sub
- Afficher un dossier par défaut lors de l'ouverture de la boite de dialogue "ouvrir fichier"
Sub boiteDialogueOuvrir() chDir ("C:\Documents and Settings\mon répertoire") Application.Dialogs(xlDialogOpen).Show End Sub une autre méthode Sub boiteDialogueOuvrir() Application.Dialogs(xlDialogOpen).Show "C:\Documents and Settings\mon répertoire" End Sub
- Parametrer par macro les arguments de la boite de dialogue xlDialogCopyPicture
'appearance_num, size_num, type_num '1= 1ere option de chaque argument '2= 2eme option de chaque argument Application.Dialogs.Item(xlDialogCopyPicture).Show 1, 1, 2
- Afficher un Msgbox temporaire , exemple de 3 secondes
Sub messageProvisoire() createObject("Wscript.shell").Popup "Mon Texte", 3, "Le Titre" End Sub
- Afficher la boite de dialogue "Rechercher" (équivalent de Ctrl + F )
'Range("A1").Select 'Si lancé depuis un Commandbutton commandBars("Edit").Controls(14).Execute
- Utiliser le bouton d'aide dans un msgBox (vbMsgBoxHelpButton)
Le lien sur le forum XLD
- Lister le nom des fichiers en multisélection dans la boite de dialogue "Ouvrir"
Dim Fichiers As Variant Dim i As Integer Fichiers = Application.getOpenFilename(, , , , True) If isArray(Fichiers) Then For i = 1 To UBound(Fichiers) msgBox Fichiers(i) Next End If
Les classeurs- Ouvrir un classeur
Sub ouvrirClasseur() Workbooks.Open "C:\Mes documents\test.xls" End Sub
- Fermer le classeur actif
Sub fermerClasseur() activeWorkBook.Close 'saveChanges:=False 'ou True pour gerer les modifications End Sub
- Creer un nouveau classeur
Sub creerClasseur() Workbooks.Add End Sub
- Afficher le chemin complet et le nom du classeur actif
Sub cheminClasseur() msgBox activeWorkbook.fullName End Sub
- Empecher la fermeture du classeur par la croix
Private Sub workbook_beforeClose(Cancel As Boolean) if cancel=false then _ msgbox"Veuillez utilser le bouton prévu à cet effet" : cancel=true End Sub
- Lister tous les classeurs ouverts
Sub listeClasseursOuverts() Dim Wb As Workbook For Each Wb In Workbooks msgBox Wb.Name Next Wb End Sub
- Vérifier si un classeur nommé "Classeur1" est ouvert
Sub verifClasseurOuvert() Dim Wb As Workbook For Each Wb In Workbooks If Wb.Name = "Classeur1" Then msgBox "Le Classeur est ouvert ." Exit Sub End If Next Wb msgBox "Le classeur n'est pas ouvert . " End Sub
- Autoriser les modifications dans un classeur uniquement par macro
Private Sub Workbook_Open() Dim Sht As Worksheet For Each Sht In Worksheets Sht.Protect userInterfaceOnly:=True Next Sht End Sub
- Ajouter un élément dans la liste des classeurs récemment utilisés
Application.recentFiles.Add Name:="monClasseur.xls"
- Suivre l'utilisation d'un classeur partagé en réseau
renvoyer le nom de l'utilisateur chez qui le fichier est ouvert , en tenant compte des ouvertures en lecture seule Le lien sur le forum XLD
- Mettre à jour les liaisons, sans afficher la boite de dialogue , lors de l'ouverture d'un classeur
Set Wb = Workbooks.Open("C:\monClasseur.xls" , 3 ) Remplacer le 3 par un 0 pour ne pas mettre à jour les liaisons
- Lister les utilisateurs d'un classeur partagé
Sub listerUtilsateursClasseur() 'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaxl11/html/xlproUserStatus1_HV05205754.asp Dim Users() Dim i As Byte Users = activeWorkbook.userStatus With Workbooks.Add.Sheets(1) For i = 1 To UBound(Users, 1) .Cells(i, 1) = Users(i, 1) .Cells(i, 2) = Users(i, 2) Select Case Users(i, 3) Case 1 .Cells(i, 3).Value = "Exclusive" Case 2 .Cells(i, 3).Value = "Shared" End Select Next End With End Sub
- Choisir un classeur dans une boite de dialogue et le renommer
Sub renommerClasseur() Dim Classeur As String, Chemin As String Dim Fso As Object Classeur = Application.getOpenFilename("Fichiers Excel (*.xls), *.xls") If Classeur = "Faux" Then Exit Sub Set Fso = createObject("Scripting.fileSystemObject") Chemin = Fso.getFile(Classeur).parentFolder Name Classeur As Chemin & "\nouveauNom.xls" End Sub
- Lister les classeurs récents
Représente les classeurs dans la liste des derniers fichiers utilisés (menu Fichier). Dim Rf As recentFile For Each Rf In Application.recentFiles msgBox Rf.Path & vbCrLf & Dir(Rf.Path) Next
Si 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 à 22h36.
|
08/03/2008, 17h07
