[REF] Wiki 1 de MichelXld (Généralités Excel)

MichelXld

XLDnaute Barbatruc
GENERALITES EXCEL
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 .​



LES FEUILLES EXCEL

Quelques exemples d'actions VBA sur les feuilles :
  • Renommer la feuille active
  • Supprimer une feuille
  • Trier les onglets par ordre alphabetique
  • Protéger er déproteger une feuillle par macro
>> Le lien
>> Le fichier


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
VB:
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
VB:
Worksheets(Worksheets.Count).Select
Supprimer la premiere feuille du classeur
VB:
Worksheets(1).Delete
Un autre exemple qui permet de choisir la ou les feuilles à supprimer depuis une Listbox
>> Le lien

Masquer les onglets
VB:
activewindow.displayworkbookTabs = False
Afficher les onglets
VB:
activewindow.displayworkbookTabs = True
Ajouter une nouvelle feuille , la positionner à la fin du classeur et la renommer
VB:
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
VB:
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
VB:
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
VB:
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
VB:
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
Un autre exemple : insérer le chemin complet du classeur en pied de page
>> Le lien
A partir d'Excel2002 , il est possible d'insérer cette information dans les entêtes et pied de page sans macro
Pour personnaliser le format du pied de page (police , gras , taille 20 et souligné) :
VB:
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

Insérer des sous totaux à chaque saut de page
>> Le lien

Retrouver un mot de passe oublié : Déprotection de la feuille active
>>Le lien
Deux autres solutions proposées par myDearFriend et michel_M
>> Le lien

Limiter la possibilité de déplacement à la plage A1:E50 , dans la feuille active
VB:
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
VB:
msgBox thisWorkbook.Windows(1).selectedSheets.Count
Récuperer la valeur du zoom de la fenetre active
VB:
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
VB:
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

Insérer une colonne à l'emplacement de la colonne B
VB:
Columns("B:B").Insert
Insérer un saut de page avant la 25eme ligne de la feuille active
VB:
activeSheet.HPageBreaks.Add Before:=Cells(25, 1)
Créer des sauts de page toutes les 10 lignes , jusqu'à la ligne 50
VB:
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
VB:
activeWindow.View = xlPageBreakPreview
Desactiver l'aperçu des sauts de page
VB:
activeWindow.View = xlNormalView
Appliquer une Couleur jaune à l'onglet de la Feuil1 (fonctionne uniquement à partir d'Excel2002)
VB:
Sheets("Feuil1").Tab.colorIndex = 6
Regrouper les données de toutes les feuilles dans un onglet unique
VB:
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
>> Le fichier


Supprimer la ligne complete si les cellules sont vides dans la colonne F
VB:
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
VB:
Sheets(Array("Feuil1", "Feuil3")).Copy
Supprimer les lignes , si les cellules de la colonne A contiennent une erreur type #N/A
VB:
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
VB:
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."
VB:
Application.addCustomList Array("Blanc", "Vert", "Rouge", "Bleu", "Noir")
Si les données sont dans une plage de cellules , utilisez :
VB:
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
>> Le fichier


Un autre exemple
>> Le lien
>> Le fichier


Changer la position et la taille des graphiques dans une feuille
>> Le lien
>> Le fichier


Selectionner les cellules par Application.inputbox puis Inserer une nouvelle courbe
>> Le lien
>> Le fichier


Adapter la position d'un graphique par rapports aux sauts de page
>> Le lien
>> Le fichier


Graphique dans userform
>> Le lien
>> Le fichier


Gerer plusieurs séries
>> Le lien
>> Le fichier


Afficher la plage de données en abscisses , d'un graphique
VB:
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
VB:
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"
VB:
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
>> Le fichier


Supprimer un graphique
VB:
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
VB:
activeSheet.chartObjects.Delete
Adapter la position d'un graphique sur une plage de Cellules A20:G40
VB:
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
>> Le fichier

Choisir dans une Listbox parmi plusieurs courbes, avec une option pour préciser la période d'affichage des données
>> Le fichier

Compter le nombre de graphiques dans la feuille active
VB:
msgBox activeSheet.chartObjects.Count
Créer un graphique et le renommer
>> Le lien

Utiliser un tableau Array pour définir les abscisses de la 1ere série du graphique actif
VB:
Activechart.seriesCollection(1).XValues = Array(5, 7,9,11,13,15)
Création d'un graphique à partir de tableaux Array
VB:
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
VB:
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
VB:
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 :
VB:
activeChart.seriesCollection(2).chartType = xlLine
Modifier les couleurs d'un graphique en secteur , en fonction des étiquettes
>> Le lien

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 )
VB:
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

Animer un graphique
>> Le lien
>> La démo de Didier myDearFriend
>> La démo de Jean Marie

Lister tous les graphiques d'un classeur
>> Le lien
>> Le fichier

Savoir si un Graphique est issu d'un TCD ( renvoie Vrai ou Faux )
VB:
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
VB:
Feuil1.drawingObjects("Graphique 1").printObject = False
Imprimer le 2eme graphique contenu dans le Feuil1
VB:
Feuil1.chartObjects(2).Chart.printOut
Définir la plage des abscisses dans le graphique actif
VB:
Dim Plage As Range
Set Plage = Feuil1.Range("A1:A10")
activeChart.seriesCollection(1).XValues = Plage
Ajouter un titre dans le graphique
VB:
With Sheets(1).chartObjects(1).Chart
.hasTitle = True
.chartTitle.Characters.Text = "XLD"
End With
Récupérer le titre du graphique
VB:
msgBox Sheets(1).chartObjects(1).Chart.chartTitle.Characters.Text
Ajouter une droite verticale dans un graphique en barre
>> Le fichier

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
>> Le fichier

Des bulles et des nuages de points dans un meme graphique
>> Le lien
>> Le fichier

Afficher une droite d'équation dans un graphique à bulles (une démo de Myta)
>> Le lien
>> Le fichier

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
VB:
Sub equationsCourbeDeTendance()
Dim Equation As String
With Feuil1.chartObjects(1).Chart.seriesCollection(1).Trendlines(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
VB:
msgBox activeChart.seriesCollection(1).markerBackgroundColorIndex
Récupérer la couleur d'arrière-plan du 2eme point dans la premiere serie d'un graphique en nuage de points
VB:
msgBox activeChart.seriesCollection(1).Points(2).markerBackgroundColorIndex
Modifier la couleur d'arrière-plan du 2eme point dans la premiere serie d'un graphique en nuage de points
VB:
activeChart.seriesCollection(1).Points(2).markerBackgroundColorIndex = 4 'Vert
Transformer une feuille graphique "Graph1" en objet dans la feuille "Feuil1"
VB:
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
>> Le fichier

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

Enlever la couleur dans la zone de traçage
VB:
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
VB:
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
VB:
Feuil1.chartObjects(1).Chart.chartArea.clearContents
Les evenements dans la feuille graphique

L'activation du graphique
VB:
Private Sub Chart_Activate()
Le double clic dans le graphique
VB:
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
VB:
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
VB:
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
VB:
Private Sub Chart_Deactivate()
Les mouvements de la souris dans un graphique
VB:
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
VB:
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
VB:
Private Sub Chart_seriesChange(byVal seriesIndex As Long, byVal pointIndex As Long)
Remarque :
Pour gérer les événements d'un graphique incorporé dans la feuille de calcul , il faut utiliser des modules de classe .
D'autres informations complémentaires
>> Le lien

Vérifier si un graphique nommé "Graphique 1" existe dans la Feuil2
VB:
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
VB:
'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
Empêcher le copier/coller d'une feuille graphique
VB:
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
VB:
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).markerBackgroundColorIndex = _
activeChart.plotArea.Interior.colorIndex
activeChart.seriesCollection(1).markerForegroundColorIndex = _
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
>> Le fichier

Créer un graphique en utilisant une plage de données dynamique .

Un 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

Afficher dans les labels l'évolution des valeurs d'une série en fonction du point précédent .
VB:
Sub afficherEvolutionPourcentage_enFonctionDuPointPrecedent()
'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).dataLabels.Delete
On Error goTo 0
'affichage des Labels (Ordonnées) pour en extraire les valeurs
Feuil1.chartObjects(1).Chart.seriesCollection(1).applyDataLabels 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).Points.Count
X = Feuil1.chartObjects(1).Chart.seriesCollection(1).Points(j).dataLabel.Characters.Text 'valeur du point
Y = Feuil1.chartObjects(1).Chart.seriesCollection(1).Points(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).Points(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).Points(j - 1).dataLabel.Characters.Text = Resultat
End Sub
Changer la taille des caracteres dans un graphique
VB:
activeSheet.chartObjects("Graphique 1").Chart.chartArea.Font.Size = 8
Créer et Afficher une graphique dans une fenetre popup Internet Explorer
VB:
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).Height * 1.8
Largeur = Feuil1.chartObjects(Feuil1.chartObjects.Count).Width * 1.6
Sheets("Feuil1").chartObjects(Sheets("Feuil1").chartObjects.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
VB:
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)



LES IMAGES

Inserer une image dans une plage de cellule

>> Le lien
>> Le fichier

Recuperer une image sur internet, l'enregistrer sur le disque et l'inserer dans une plage de cellule
>> Le lien
>> Le fichier
Une autre solution beaucoup plus simple (sans enregistrement sur le disque)
VB:
Sub insereImage()
activeSheet.Pictures. _
Insert("http://www.excel-downloads.com/images/titres/logoED.gif").Select
End Sub

Extraire toutes les images d'une feuille
VB:
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
VB:
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
VB:
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
VB:
Sub suppressionImagesFeuille()
activeSheet.Pictures.Delete
End Sub
Une autre solution
VB:
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
>> Le fichier

Choisir une image dans un répertoire et afficher ses dimensions
VB:
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
VB:
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
>> Le fichier

Sauvegarder et visualiser des images GIF animées , dans le classeur

>> Le lien
>> Le fichier
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

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)
VB:
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 PROPRIETES DU CLASSEUR

Les propriétés d'un classeur par la fonction getFile

VB:
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
VB:
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
VB:
thisWorkbook.builtinDocumentProperties("Author").Value = "xld"
Ajouter une propriété personnalisée dans le classeur actif
VB:
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
VB:
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
VB:
msgBox activeWorkbook.customDocumentProperties("infoX").Value
Modfifier une propriété personnalisee
VB:
activeWorkbook.customDocumentProperties("infoX").Value = 1997
Supprimer une propriété personnalisée
VB:
activeWorkbook.customDocumentProperties("infoX").Delete
Afficher les propriétés de tous les fichiers d'un répertoire, sans les ouvrir
VB:
Sub propriétésFichiers()
'[URL='http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx'][COLOR=#0000ff]http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx[/COLOR][/URL]
'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

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 …)
VB:
Sub lireProprietesClasseur()
'necessite d'activer la reference DSO oleDocument Properties Reader 2.0
'[URL='http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351'][COLOR=#0000ff]http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351[/COLOR][/URL]
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.xls"
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
VB:
'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
VB:
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
VB:
Sub lireProprietesPersonnalisees()
'necessite d'activer la reference DSO oleDocument Properties Reader 2.0
'[URL='http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351'][COLOR=#0000ff]http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351[/COLOR][/URL]
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("leNomDeMaProprietePersonnalisee").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
VB:
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
VB:
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
>> Le fichier

Sauvegarder un classeur automatiquement toutes les XX minutes
>> Le lien

Sauvegarder uniquement la feuille active
VB:
Sub enregistrerFeuilleActive()
activeSheet.Copy
activeWorkbook.saveAs Filename:="C:\Sauvegarde\test.xls"
End Sub
Deux méthodes pour afficher la boite de dialogue Enregistrer Sous
VB:
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

Incrémentation d'une unité dans le nom des classeurs sauvegardés
>> Le lien

Bloquer l'utilisation du bouton "enregistrer sous"
Procédure evenementielle à placer au niveau de thisWorkbook .
VB:
Private Sub Workbook_beforeSave(byVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then Cancel = True
End Sub
LES SHAPES / LES FORMES AUTOMATIQUES

Deplacer les shapes dans une feuille

>> Le lien
>> Le fichier

Creer un shape
VB:
Sub creerShapes()
With Sheets(1).Shapes.addShape(msoShapeRectangle, 100, 100, 100, 100)
.Name = "cible"
.textFrame.Characters.Text = "XLD forum"
End With
End Sub
D'autres exemples de création
>> Le lien
>> Le fichier

Un pourcentage de couleur dans une forme Word Art
>> Le lien
>> Le fichier

funFoot un jeu avec mouvement aleatoire de la forme
>> Le lien
>> Le fichier

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
>> Le fichier

Plusieurs shapes qui suivent le curseur de la souris
>> Le fichier

Oter toutes les affectations de macros , pour les formes automatiques( et graphiques ) de la Feuil1
VB:
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 .
VB:
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
VB:
activeSheet.Hyperlinks.Add Anchor:=activeSheet.Shapes(1), Address:="C:\monClasseur.xls"

[B]Supprimer toutes les formes automatiques de la feuille active[/B]
[CODE=vb]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
VB:
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
VB:
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.
VB:
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
>> Le fichier

Afficher un nombre aleatoire entre 1 et 6
VB:
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
VB:
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

Afficher un nombre aléatoire dans une plage de valeurs (entre 10 et 15 dans l'exemple )
VB:
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
VB:
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

Afficher le menu contextuel par macro ( le menu qui apparait lors du clic droit dans une cellule)
VB:
Sub afficherMenuContextuel()
Application.commandBars("Cell").showPopup
End Sub
Afficher la barre de statut et y insérer une information
VB:
Application.displayStatusBar = True
Application.statusBar = "le forum XLD"
Réinitialiser le menu contextuel
VB:
Sub reinitialiserMenuContextuelDisparu()
Application.commandBars("cell").Reset
End Sub
Lister les controles contenus dans le menu contextuel
VB:
Sub listerControlesMenucontextuel()
Dim i As Integer
For i = 1 To Application.commandBars("cell").Controls.Count
Cells(i, 1) = Application.commandBars("cell").Controls(i).Caption
Next i
End Sub
Masquer la barre de statut
VB:
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
>> Le fichier

Réafficher une barre d'outils disparue
(exemple de la barre Web )
VB:
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

Attacher une image à un bouton , dans une barre d'outils personnalisée
VB:
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


LES BOITES DE DIALOGUE INTEGREES EXCEL

Un mini tutorial basique sur les Msgbox , Inputbox et l'assistant animation

>> Le lien
>> Le fichier

Inputbox : Intercepter l'utilisation du bouton Annuler
VB:
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
VB:
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"
VB:
Sub boiteDialogueOuvrir()
chDir ("C:\Documents and Settings\mon répertoire")
Application.Dialogs(xlDialogOpen).Show
End Sub
une autre méthode
VB:
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
VB:
'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
VB:
Sub messageProvisoire()
createObject("Wscript.shell").Popup "Mon Texte", 3, "Le Titre"
End Sub
Afficher la boite de dialogue "Rechercher" (équivalent de Ctrl + F )
VB:
'Range("A1").Select 'Si lancé depuis un Commandbutton
commandBars("Edit").Controls(14).Execute
Utiliser le bouton d'aide dans un msgBox (vbMsgBoxHelpButton)
>> Le lien

Lister le nom des fichiers en multisélection dans la boite de dialogue "Ouvrir"
VB:
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

VB:
Sub ouvrirClasseur()
Workbooks.Open "C:\Mes documents\test.xls"
End Sub
Fermer le classeur actif
VB:
Sub fermerClasseur()
activeWorkBook.Close 'saveChanges:=False 'ou True pour gerer les modifications
End Sub
Creer un nouveau classeur
VB:
Sub creerClasseur()
Workbooks.Add
End Sub
Afficher le chemin complet et le nom du classeur actif
VB:
Sub cheminClasseur()
msgBox activeWorkbook.fullName
End Sub
Empecher la fermeture du classeur par la croix
VB:
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
VB:
Sub listeClasseursOuverts()
Dim Wb As Workbook
For Each Wb In Workbooks
msgBox Wb.Name
Next Wb
End Sub

[B]Vérifier si un classeur nommé "Classeur1" est ouvert[/B]
[CODE=vb]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
VB:
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
VB:
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

Mettre à jour les liaisons, sans afficher la boite de dialogue , lors de l'ouverture d'un classeur
VB:
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é
VB:
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
VB:
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).
VB:
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 édition par un modérateur:
Bonjour à tous,
Opération "Revival!!!" : j'ai remis à jour tous les liens qui étaient mort sur la Wiki page N° 1 de Michel.
J'en ai profité pour faire un lifting en rajoutant des balises qui n'existaient pas à l'époque... et oui cette page a été créée en 2006.
Un excellent moyen de découvrir ou redécouvrir l'excellence de Michel qui a été un des membres phare de notre forum.
Merci encore à Michel pour tout ce qu'il a fait pour ce site.
David
Ps: je passe à la page 2 ;)
 

Staple1600

XLDnaute Barbatruc
Bonsoir David

Merci pour cette excellente initiative
Et bon courage pour la page 2;)

(De mémoire, il y avait pas 7 ou 9 pages, non ?)
EDITION:
En fait, non, il y en 11! (merci le sommaire)
N'oublie pas de prendre des sucres lents avant d'entamer ce long labeur ;)
 

girolle74

XLDnaute Nouveau
GENERALITES EXCEL
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 .​



LES FEUILLES EXCEL

Quelques exemples d'actions VBA sur les feuilles :
  • Renommer la feuille active
  • Supprimer une feuille
  • Trier les onglets par ordre alphabetique
  • Protéger er déproteger une feuillle par macro
>> Le lien
>> Le fichier


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
VB:
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
VB:
Worksheets(Worksheets.Count).Select
Supprimer la premiere feuille du classeur
VB:
Worksheets(1).Delete
Un autre exemple qui permet de choisir la ou les feuilles à supprimer depuis une Listbox
>> Le lien

Masquer les onglets
VB:
activewindow.displayworkbookTabs = False
Afficher les onglets
VB:
activewindow.displayworkbookTabs = True
Ajouter une nouvelle feuille , la positionner à la fin du classeur et la renommer
VB:
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
VB:
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
VB:
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
VB:
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
VB:
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
Un autre exemple : insérer le chemin complet du classeur en pied de page
>> Le lien
A partir d'Excel2002 , il est possible d'insérer cette information dans les entêtes et pied de page sans macro
Pour personnaliser le format du pied de page (police , gras , taille 20 et souligné) :
VB:
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

Insérer des sous totaux à chaque saut de page
>> Le lien

Retrouver un mot de passe oublié : Déprotection de la feuille active
>>Le lien
Deux autres solutions proposées par myDearFriend et michel_M
>> Le lien

Limiter la possibilité de déplacement à la plage A1:E50 , dans la feuille active
VB:
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
VB:
msgBox thisWorkbook.Windows(1).selectedSheets.Count
Récuperer la valeur du zoom de la fenetre active
VB:
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
VB:
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

Insérer une colonne à l'emplacement de la colonne B
VB:
Columns("B:B").Insert
Insérer un saut de page avant la 25eme ligne de la feuille active
VB:
activeSheet.HPageBreaks.Add Before:=Cells(25, 1)
Créer des sauts de page toutes les 10 lignes , jusqu'à la ligne 50
VB:
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
VB:
activeWindow.View = xlPageBreakPreview
Desactiver l'aperçu des sauts de page
VB:
activeWindow.View = xlNormalView
Appliquer une Couleur jaune à l'onglet de la Feuil1 (fonctionne uniquement à partir d'Excel2002)
VB:
Sheets("Feuil1").Tab.colorIndex = 6
Regrouper les données de toutes les feuilles dans un onglet unique
VB:
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
>> Le fichier


Supprimer la ligne complete si les cellules sont vides dans la colonne F
VB:
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
VB:
Sheets(Array("Feuil1", "Feuil3")).Copy
Supprimer les lignes , si les cellules de la colonne A contiennent une erreur type #N/A
VB:
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
VB:
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."
VB:
Application.addCustomList Array("Blanc", "Vert", "Rouge", "Bleu", "Noir")
Si les données sont dans une plage de cellules , utilisez :
VB:
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
>> Le fichier


Un autre exemple
>> Le lien
>> Le fichier


Changer la position et la taille des graphiques dans une feuille
>> Le lien
>> Le fichier


Selectionner les cellules par Application.inputbox puis Inserer une nouvelle courbe
>> Le lien
>> Le fichier


Adapter la position d'un graphique par rapports aux sauts de page
>> Le lien
>> Le fichier


Graphique dans userform
>> Le lien
>> Le fichier


Gerer plusieurs séries
>> Le lien
>> Le fichier


Afficher la plage de données en abscisses , d'un graphique
VB:
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
VB:
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"
VB:
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
>> Le fichier


Supprimer un graphique
VB:
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
VB:
activeSheet.chartObjects.Delete
Adapter la position d'un graphique sur une plage de Cellules A20:G40
VB:
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
>> Le fichier

Choisir dans une Listbox parmi plusieurs courbes, avec une option pour préciser la période d'affichage des données
>> Le fichier

Compter le nombre de graphiques dans la feuille active
VB:
msgBox activeSheet.chartObjects.Count
Créer un graphique et le renommer
>> Le lien

Utiliser un tableau Array pour définir les abscisses de la 1ere série du graphique actif
VB:
Activechart.seriesCollection(1).XValues = Array(5, 7,9,11,13,15)
Création d'un graphique à partir de tableaux Array
VB:
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
VB:
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
VB:
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 :
VB:
activeChart.seriesCollection(2).chartType = xlLine
Modifier les couleurs d'un graphique en secteur , en fonction des étiquettes
>> Le lien

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 )
VB:
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

Animer un graphique
>> Le lien
>> La démo de Didier myDearFriend
>> La démo de Jean Marie

Lister tous les graphiques d'un classeur
>> Le lien
>> Le fichier

Savoir si un Graphique est issu d'un TCD ( renvoie Vrai ou Faux )
VB:
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
VB:
Feuil1.drawingObjects("Graphique 1").printObject = False
Imprimer le 2eme graphique contenu dans le Feuil1
VB:
Feuil1.chartObjects(2).Chart.printOut
Définir la plage des abscisses dans le graphique actif
VB:
Dim Plage As Range
Set Plage = Feuil1.Range("A1:A10")
activeChart.seriesCollection(1).XValues = Plage
Ajouter un titre dans le graphique
VB:
With Sheets(1).chartObjects(1).Chart
.hasTitle = True
.chartTitle.Characters.Text = "XLD"
End With
Récupérer le titre du graphique
VB:
msgBox Sheets(1).chartObjects(1).Chart.chartTitle.Characters.Text
Ajouter une droite verticale dans un graphique en barre
>> Le fichier

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
>> Le fichier

Des bulles et des nuages de points dans un meme graphique
>> Le lien
>> Le fichier

Afficher une droite d'équation dans un graphique à bulles (une démo de Myta)
>> Le lien
>> Le fichier

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
VB:
Sub equationsCourbeDeTendance()
Dim Equation As String
With Feuil1.chartObjects(1).Chart.seriesCollection(1).Trendlines(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
VB:
msgBox activeChart.seriesCollection(1).markerBackgroundColorIndex
Récupérer la couleur d'arrière-plan du 2eme point dans la premiere serie d'un graphique en nuage de points
VB:
msgBox activeChart.seriesCollection(1).Points(2).markerBackgroundColorIndex
Modifier la couleur d'arrière-plan du 2eme point dans la premiere serie d'un graphique en nuage de points
VB:
activeChart.seriesCollection(1).Points(2).markerBackgroundColorIndex = 4 'Vert
Transformer une feuille graphique "Graph1" en objet dans la feuille "Feuil1"
VB:
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
>> Le fichier

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

Enlever la couleur dans la zone de traçage
VB:
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
VB:
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
VB:
Feuil1.chartObjects(1).Chart.chartArea.clearContents
Les evenements dans la feuille graphique

L'activation du graphique
VB:
Private Sub Chart_Activate()
Le double clic dans le graphique
VB:
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
VB:
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
VB:
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
VB:
Private Sub Chart_Deactivate()
Les mouvements de la souris dans un graphique
VB:
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
VB:
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
VB:
Private Sub Chart_seriesChange(byVal seriesIndex As Long, byVal pointIndex As Long)
Remarque :
Pour gérer les événements d'un graphique incorporé dans la feuille de calcul , il faut utiliser des modules de classe .
D'autres informations complémentaires
>> Le lien

Vérifier si un graphique nommé "Graphique 1" existe dans la Feuil2
VB:
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
VB:
'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
Empêcher le copier/coller d'une feuille graphique
VB:
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
VB:
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).markerBackgroundColorIndex = _
activeChart.plotArea.Interior.colorIndex
activeChart.seriesCollection(1).markerForegroundColorIndex = _
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
>> Le fichier

Créer un graphique en utilisant une plage de données dynamique .

Un 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

Afficher dans les labels l'évolution des valeurs d'une série en fonction du point précédent .
VB:
Sub afficherEvolutionPourcentage_enFonctionDuPointPrecedent()
'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).dataLabels.Delete
On Error goTo 0
'affichage des Labels (Ordonnées) pour en extraire les valeurs
Feuil1.chartObjects(1).Chart.seriesCollection(1).applyDataLabels 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).Points.Count
X = Feuil1.chartObjects(1).Chart.seriesCollection(1).Points(j).dataLabel.Characters.Text 'valeur du point
Y = Feuil1.chartObjects(1).Chart.seriesCollection(1).Points(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).Points(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).Points(j - 1).dataLabel.Characters.Text = Resultat
End Sub
Changer la taille des caracteres dans un graphique
VB:
activeSheet.chartObjects("Graphique 1").Chart.chartArea.Font.Size = 8
Créer et Afficher une graphique dans une fenetre popup Internet Explorer
VB:
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).Height * 1.8
Largeur = Feuil1.chartObjects(Feuil1.chartObjects.Count).Width * 1.6
Sheets("Feuil1").chartObjects(Sheets("Feuil1").chartObjects.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
VB:
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)



LES IMAGES

Inserer une image dans une plage de cellule

>> Le lien
>> Le fichier

Recuperer une image sur internet, l'enregistrer sur le disque et l'inserer dans une plage de cellule
>> Le lien
>> Le fichier
Une autre solution beaucoup plus simple (sans enregistrement sur le disque)
VB:
Sub insereImage()
activeSheet.Pictures. _
Insert("http://www.excel-downloads.com/images/titres/logoED.gif").Select
End Sub

Extraire toutes les images d'une feuille
VB:
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
VB:
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
VB:
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
VB:
Sub suppressionImagesFeuille()
activeSheet.Pictures.Delete
End Sub
Une autre solution
VB:
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
>> Le fichier

Choisir une image dans un répertoire et afficher ses dimensions
VB:
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
VB:
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
>> Le fichier

Sauvegarder et visualiser des images GIF animées , dans le classeur

>> Le lien
>> Le fichier
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

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)
VB:
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 PROPRIETES DU CLASSEUR

Les propriétés d'un classeur par la fonction getFile

VB:
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
VB:
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
VB:
thisWorkbook.builtinDocumentProperties("Author").Value = "xld"
Ajouter une propriété personnalisée dans le classeur actif
VB:
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
VB:
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
VB:
msgBox activeWorkbook.customDocumentProperties("infoX").Value
Modfifier une propriété personnalisee
VB:
activeWorkbook.customDocumentProperties("infoX").Value = 1997
Supprimer une propriété personnalisée
VB:
activeWorkbook.customDocumentProperties("infoX").Delete
Afficher les propriétés de tous les fichiers d'un répertoire, sans les ouvrir
VB:
Sub propriétésFichiers()
'[URL='http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx'][COLOR=#0000ff]http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx[/COLOR][/URL]
'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

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 …)
VB:
Sub lireProprietesClasseur()
'necessite d'activer la reference DSO oleDocument Properties Reader 2.0
'[URL='http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351'][COLOR=#0000ff]http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351[/COLOR][/URL]
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.xls"
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
VB:
'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
VB:
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
VB:
Sub lireProprietesPersonnalisees()
'necessite d'activer la reference DSO oleDocument Properties Reader 2.0
'[URL='http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351'][COLOR=#0000ff]http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351[/COLOR][/URL]
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("leNomDeMaProprietePersonnalisee").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
VB:
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
VB:
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
>> Le fichier

Sauvegarder un classeur automatiquement toutes les XX minutes
>> Le lien

Sauvegarder uniquement la feuille active
VB:
Sub enregistrerFeuilleActive()
activeSheet.Copy
activeWorkbook.saveAs Filename:="C:\Sauvegarde\test.xls"
End Sub
Deux méthodes pour afficher la boite de dialogue Enregistrer Sous
VB:
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

Incrémentation d'une unité dans le nom des classeurs sauvegardés
>> Le lien

Bloquer l'utilisation du bouton "enregistrer sous"
Procédure evenementielle à placer au niveau de thisWorkbook .
VB:
Private Sub Workbook_beforeSave(byVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then Cancel = True
End Sub
LES SHAPES / LES FORMES AUTOMATIQUES

Deplacer les shapes dans une feuille

>> Le lien
>> Le fichier

Creer un shape
VB:
Sub creerShapes()
With Sheets(1).Shapes.addShape(msoShapeRectangle, 100, 100, 100, 100)
.Name = "cible"
.textFrame.Characters.Text = "XLD forum"
End With
End Sub
D'autres exemples de création
>> Le lien
>> Le fichier

Un pourcentage de couleur dans une forme Word Art
>> Le lien
>> Le fichier

funFoot un jeu avec mouvement aleatoire de la forme
>> Le lien
>> Le fichier

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
>> Le fichier

Plusieurs shapes qui suivent le curseur de la souris
>> Le fichier

Oter toutes les affectations de macros , pour les formes automatiques( et graphiques ) de la Feuil1
VB:
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 .
VB:
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
VB:
activeSheet.Hyperlinks.Add Anchor:=activeSheet.Shapes(1), Address:="C:\monClasseur.xls"

[B]Supprimer toutes les formes automatiques de la feuille active[/B]
[CODE=vb]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
VB:
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
VB:
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.
VB:
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
>> Le fichier

Afficher un nombre aleatoire entre 1 et 6
VB:
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
VB:
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

Afficher un nombre aléatoire dans une plage de valeurs (entre 10 et 15 dans l'exemple )
VB:
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
VB:
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

Afficher le menu contextuel par macro ( le menu qui apparait lors du clic droit dans une cellule)
VB:
Sub afficherMenuContextuel()
Application.commandBars("Cell").showPopup
End Sub
Afficher la barre de statut et y insérer une information
VB:
Application.displayStatusBar = True
Application.statusBar = "le forum XLD"
Réinitialiser le menu contextuel
VB:
Sub reinitialiserMenuContextuelDisparu()
Application.commandBars("cell").Reset
End Sub
Lister les controles contenus dans le menu contextuel
VB:
Sub listerControlesMenucontextuel()
Dim i As Integer
For i = 1 To Application.commandBars("cell").Controls.Count
Cells(i, 1) = Application.commandBars("cell").Controls(i).Caption
Next i
End Sub
Masquer la barre de statut
VB:
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
>> Le fichier

Réafficher une barre d'outils disparue
(exemple de la barre Web )
VB:
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

Attacher une image à un bouton , dans une barre d'outils personnalisée
VB:
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


LES BOITES DE DIALOGUE INTEGREES EXCEL

Un mini tutorial basique sur les Msgbox , Inputbox et l'assistant animation

>> Le lien
>> Le fichier

Inputbox : Intercepter l'utilisation du bouton Annuler
VB:
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
VB:
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"
VB:
Sub boiteDialogueOuvrir()
chDir ("C:\Documents and Settings\mon répertoire")
Application.Dialogs(xlDialogOpen).Show
End Sub
une autre méthode
VB:
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
VB:
'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
VB:
Sub messageProvisoire()
createObject("Wscript.shell").Popup "Mon Texte", 3, "Le Titre"
End Sub
Afficher la boite de dialogue "Rechercher" (équivalent de Ctrl + F )
VB:
'Range("A1").Select 'Si lancé depuis un Commandbutton
commandBars("Edit").Controls(14).Execute
Utiliser le bouton d'aide dans un msgBox (vbMsgBoxHelpButton)
>> Le lien

Lister le nom des fichiers en multisélection dans la boite de dialogue "Ouvrir"
VB:
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

VB:
Sub ouvrirClasseur()
Workbooks.Open "C:\Mes documents\test.xls"
End Sub
Fermer le classeur actif
VB:
Sub fermerClasseur()
activeWorkBook.Close 'saveChanges:=False 'ou True pour gerer les modifications
End Sub
Creer un nouveau classeur
VB:
Sub creerClasseur()
Workbooks.Add
End Sub
Afficher le chemin complet et le nom du classeur actif
VB:
Sub cheminClasseur()
msgBox activeWorkbook.fullName
End Sub
Empecher la fermeture du classeur par la croix
VB:
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
VB:
Sub listeClasseursOuverts()
Dim Wb As Workbook
For Each Wb In Workbooks
msgBox Wb.Name
Next Wb
End Sub

[B]Vérifier si un classeur nommé "Classeur1" est ouvert[/B]
[CODE=vb]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
VB:
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
VB:
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

Mettre à jour les liaisons, sans afficher la boite de dialogue , lors de l'ouverture d'un classeur
VB:
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é
VB:
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
VB:
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).
VB:
Di

m 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

Bonjour,
merci pour tous ces codes super intéressant ...

Je ne sais pas si c'est toujours d'actualité (13ans ) mais je crois avoir trouvé une petite erreur?
ici
----
Afficher un Msgbox temporaire , exemple de 3 secondes --->reste en permanence il faut cliquer "OK" pour sortir
peut-être que j'ai mal recopié le code
---
Sub messageProvisoire()
createObject("Wscript.shell").Popup "Mon Texte", 3, "Le Titre"
End Sub
---
est-ce vraiment une erreur ?
merci
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, girolle74

Ah que de souvenirs...
les fameuses pages de MichelXLD
Tout une époque XLDienne ;)

girolle74
Mais trève de nostalgie, pas d'erreur et pas besoin de cliquer sur OK.
Il suffit d'attendre 3 secondes dans l'exemple
Si c'est trop long on peut tester avec 1 seconde ;)
VB:
Sub messageProvisoire()
CreateObject("Wscript.shell").Popup "Mon Texte", 1, "Le Titre"
End Sub
NB: ne fonctionne que sous Windows (pas sur Mac)

PS: Je viens de faire le test sur XL2K3 et le MsgBox se ferme bien tout seul.
 

Best1

XLDnaute Nouveau
Bonjour tout le monde :)
J'avais fait la même remarque que girolle74. En fait le temps est comptabilisé lorsque'il n'y a pas d'action. Si vous bouger la souris le popup reste affiché. Testez donc sans toucher la souris pendant 3 secondes.

Chapeau pour ce travail au passage !!
 
Dernière édition:
Haut Bas