- Le format par défaut des classeurs pour les utilisateurs désireux de s’assurer l’emploie constant du mode de compatibilité (format 97-2003)
- L’emplacement par défaut des sauvegardes automatiques
- L’emplacement par défaut des classeurs.
- Inhiber éventuellement la sauvegarde automatique pour le classeur en cours
- 1 – C’est au cours de l’enregistrement du classeur que l’on va créer le mot de passe, donc Bouton Office / enregistrer sous
- 4 – Terminer votre enregistrement
- 1 – Avant tous vous allez charger dans votre éditeur VBA, les bibliothèques Microsoft HTML Object Library et Microsoft Internet Controls. (Si vous n’êtes pas sur de la démarche, lisez l’article du 9 Mai 2009)
- 2 – Placez dans votre feuille de calcul, deux objets WebBrower. Pour cela utiliser la commande Développeur / Insérer / Autres contrôles…Dans la liste sélectionnez le contrôle Microsoft Web Brower, cliquez sur le bouton OK et glisser pour tracer votre contrôle. La taille et la position de l’objet n’ont pas d’importance pour l’instant.
- 3 –Comme son nom l’indique un Web Brower est simplement un navigateur Internet que l’on a ici incorporé dans notre feuille de calcul. Donc il va nous permettre d’afficher des pages web et d’en étudier le contenu…
- 4 – La première partie du programme a pour objet d’afficher une page web dans le premier web browser et de trouver des informations sur cette page, notamment le nombre et la liste des images qu’elle contient.
- 6 – Voici le code, puisse t’il vous inspirer des améliorations…
Option Explicit
'ici je lance ma procédure à l'ouverture du classeur
'à vous de choisir éventuellement un autre événements et (ou) un autre objet
Dim maPageHtml As HTMLDocument
Dim imgHtml As HTMLImg
Dim resultat As String
Dim I As Integer
Dim haut As Integer
Dim larg As Integer
'position et taille du premier webbrowser
Feuil2.WebBrowser1.Left = 1
Feuil2.WebBrowser1.Top = 1
Feuil2.WebBrowser1.Width = 400
Feuil2.WebBrowser1.Height = 200
'position du seond webbrowser
Feuil2.WebBrowser2.Left = 500
Feuil2.WebBrowser2.Top = 1
'affichons une page dans le premier webbrower
Feuil2.WebBrowser1.Navigate "http://www.olivier-picot.fr/pagetest.html"
'analysons le contenu de cette page et retournons
'son url + date de modification + taille + nombre d'images
Set maPageHtml = WebBrowser1.Document
resultat = "adresse de la source : " & maPageHtml.URL & vbLf & _
"derniere modification de la page : " & maPageHtml.LastModified & vbLf & _
"taille de la page : " & maPageHtml.fileSize & " octets " & vbLf & _
"nombre d'images dans la page : " & maPageHtml.images.Length & "."
'affichons cette information
MsgBox resultat, , "Information"
'boucle sur les images pour récupérer leurs noms et écriture dans ma feuille de cacul
For I = 0 To maPageHtml.images.Length - 1
Set imgHtml = maPageHtml.images.Item(I)
Feuil2.Cells(I + 15, 1) = imgHtml.src
Next I
'**************************************
'je recupere la taille de la seconde image de ma page
Set imgHtml = maPageHtml.images.Item(1)
haut = imgHtml.Height
larg = imgHtml.Width
'pour adapter la taille de mon webbrowser à celle de mon image
Feuil2.WebBrowser2.Width = larg
Feuil2.WebBrowser2.Height = haut
'un peu de html et l'image est récupérée
.WebBrowser2.Navigate "about:
'il est impossible de passer des variables VBA au code HTML aussi cette méthode ne ‘permet de récupérer toutes les images d'une page sans les nommer une à une et les ‘afficher dans des webbrowser différents
End Sub
Dim prenom$
Déclare la variable prenom de type chaîne (String).
& Long
! Single
# Double
@ Currency
$ String
DefStr E-G, X
Sub test()
‘il devient inutile de préciser le type de ‘ces variables
Dim ea
Dim fa
Dim ga
Dim xa
ea = "A"
fa = "B"
xa = "A"
ga = ea & fa & xa
MsgBox ga
End Sub
- 1 – Commençons par une procédure permettant l’importation d’un fichier XML dans la feuille de calcul
Dim MonFichier As XmlMap
'XmlImport est une méthode de l'objet workbook
'On choisi le fichier à importer et on définie son chemin d'accès
'On crée un Mappage
'On précise la cellule de destination
ActiveWorkbook.XmlImport _
URL:=ActiveWorkbook.Path & "\albuminfo.xml", _
Importmap:=MonFichier, _
Overwrite:=False, _
Destination:=Range("$A$3")
'Il faut attribuer un nom au mappage
MonFichier.Name = "Mes Amis 3"
End Sub
'SaveAsXMLData est une méthode de l'objet workbook
'On nomme le fichier cible à exporter et on définie son chemin d'accès
'On précise le mappage à utiliser
ActiveWorkbook.SaveAsXMLData _
Filename:=ActiveWorkbook.Path & "\albuminfo3.xml", _
Map:=ActiveWorkbook.XmlMaps("Mes Amis 3")
End Sub
'XmlMaps est une méthode de l'objet workbook permettant la gestion des mappages
'XML, actualiser, supprimer, exporter
ActiveWorkbook.XmlMaps("Mes Amis 3").Import _
"C:\Documents and Settings\User\Mes documents\albuminfo.xml"
End Sub
Option Base 1
Dim i As Integer
Dim j As Integer
Dim lignefin As Integer
Dim recherche As String
Dim contenu As String
Dim tab_compare(5)
Dim compare As Long
recherche = InputBox("Veuillez entrer la valeur cherchée ?", "Welcome", "")
'La valeur saisie est transmise à la variable recherche
With ThisWorkbook.Sheets(1)
'détermination du nombre de lignes dans la base
'le nombre de colonnes est en général connu
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
lignefin = Selection.Rows.Count
'pour chaque cellule de la base
For i = 2 To lignefin + 1
For j = 1 To 5
'on parcourt, on stocke le contenu de la cellule et on compare avec la valeur saisie
Cells(i, j).Select
contenu = Cells(i, j).Value
'la fonction InStr(chaîne1, chaîne2) permet de vérifier la présence de chaîne2 dans chaîne1
'et retourne l'occurrence de la première position de la comparaison donc 0 si chaîne2 est ‘pas présente dans chaîne1
compare = InStr(1, contenu, recherche)
'pour chaque comparaison on stocke le résultat dans un tableau
If compare = 0 Then
tab_compare(j) = "Y"
Else
tab_compare(j) = "N"
End If
'il faut cinq résultats positifs pour décider de masquer la ligne
If tab_compare(1) = "Y" And tab_compare(2) = "Y" And tab_compare(3) = "Y" _
And tab_compare(4) = "Y" And tab_compare(5) = "Y" Then
Rows(i).Select
Selection.EntireRow.Hidden = True
End If
Next j
Next i
End With
End Sub
Sub Remettre()
'prévoir une macro pour réafficher les lignes
Rows("1:21").Select
Selection.EntireRow.Hidden = False
End Sub
- 2 – Réaliser un formulaire VBA (TestDate) conforme au modèle ci dessous
- 3 - Affecter la macro OuvrirFormulaire() (que vous avez saisie dans une feuille de module de code) au bouton de commande de votre feuille de calcul.
- 4 – Voici le code de cette macro…
TestDate.Chinois.Caption = ""
TestDate.Show
End Sub
- 5 – Le programme vous demande de saisir votre date de naissance puis de cliquer sur le bouton OK. Excel retourne alors votre l’horoscope chinois dans un label.
- 6 – Voici le code du programme :
'indique que les tableaux sont numérotés à partir d'un indice i=1
Option Base 1
Private Sub CalcAge_Click()
'déclaration des variables
Dim ligne As Byte
Dim anChinois As Integer
Dim col As Byte
‘On récupère l’année dans la date de naissance par extraction des 4 caractères placés à droite
anChinois = Right(datenaissance.Value, 4)
‘Maintenant il suffit de balayer le tableau et de comparer les dates
For ligne = 2 To 13
For col = 2 To 11
If Cells(ligne, col).Value = anChinois Then
Chinois.Caption = "Vous êtes " & Cells(ligne, 1).Value & " dans l'horoscope chinois."
End If
Next col
Next ligne
End Sub
Private Sub Sortir_Click()
'fermeture du formulaire
TestDate.Hide
End Sub
Pas d’article depuis début Juillet ! Il est temps de se remettre au travail ; mais comme la période est encore estivale, je vous propose un petit jeu destiné au calcul de son horoscope solaire. De quoi se familiariser avec les fonctions dates d’Excel.
- 2 – Réaliser un formulaire VBA (TestDate) conforme au modèle ci dessous
- 3 – Affecter la macro OuvrirFormulaire() (que vous avez saisie dans une feuille de module de code) au bouton de commande de votre feuille de calcul.
- 4 – Voici le code de cette macro…
With TestDate
.age.Caption = ""
.journaissance.Caption = ""
.Signe.Caption = ""
.datenaissance.Value = ""
End With
TestDate.Show
End Sub
- 5 – Le programme affiche en permanence la date et l’heure courante. Il faut saisir sa date de naissance puis cliquer sur le bouton OK. Excel retourne alors votre âge, votre jour de naissance et votre signe de l’horoscope solaire dans 3 labels différents
- 6 – Voici le code du programme :
Option Base 1
Private Sub CalcAge_Click()
'déclaration des variables
Dim dn As Date
Dim dj As Date
Dim dateSigne As Date
Dim NumJourSemaine As Byte
Dim JourSemaine As String
Dim ligne As Byte
Dim TableJourSemaine
'Calcul et affichage de l'âge avec arrondi
dj = Date
dn = datenaissance.Value
age.Caption = "Vous avez " & Int((dj - dn) / 365.25) & " ans."
'Calcul et affichage du jour de naissance
‘remplissage du tableau des jours de la semaine
TableJourSemaine = Array("Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi")
‘Weekday(n) retourne le n° d’ordre du jour dans la semaine
NumJourSemaine = Weekday(dn)
‘en fonction du numéro d’ordre le selon que va nous donner le jour
Select Case NumJourSemaine
Case 1
JourSemaine = TableJourSemaine(1)
Case 2
JourSemaine = TableJourSemaine(2)
Case 3
JourSemaine = TableJourSemaine(3)
Case 4
JourSemaine = TableJourSemaine(4)
Case 5
JourSemaine = TableJourSemaine(5)
Case 6
JourSemaine = TableJourSemaine(6)
Case 7
JourSemaine = TableJourSemaine(7)
End Select
journaissance.Caption = "Vous êtes né un " & JourSemaine & "."
'calcul et affichage de l'horoscope solaire
ligne = 2
‘il faut transformer la date saisie en une date d’année type, 2009 par exemple car le tableau du classeur correspond à une seule année
dateSigne = CDate(Left(CStr(datenaissance.Value), 6) & "2009")
While ligne >= 2 And ligne <= 13 If dateSigne >= Cells(ligne, 2).Value And dateSigne <= Cells(ligne, 3).Value Then Signe.Caption = "Vous êtes du " & Cells(ligne, 1).Value & " dans l'horoscope solaire."
Exit Sub
Else
‘il faut bloquer le passage à l’année suivante
If dateSigne >= 22 / 12 / 2009 Or dateSigne <= 20 / 1 / 2009 Then Signe.Caption = "Vous êtes du Capricorne dans l'horoscope solaire."
End If
ligne = ligne + 1
End If
Wend
End Sub
Private Sub Sortir_Click()
'fermeture du formulaire
TestDate.Hide
End Sub
Private Sub UserForm_Activate()
'affichage de la date et de l'heure courante
datejour.Caption = "Aujourd'hui : " & Date & " à " & Time
End Sub
- 1 – Dans cet exemple l’utilisateur veut à partir de son classeur actif, envoyer par mail un autre classeur Excel qu’il choisira sur son disque dur. Le programme lui demandera l’adresse Email du destinataire puis effectuera l’envoie en arrière plan.
- 3 –Voici le code, à vous de l’adapter.
Dim appOutlook As Outlook.Application
Dim message As Outlook.mailitem
Dim Adresse As String
Dim ouverture$
On Error GoTo sierreur:
'Lance une session OutLook
Set appOutlook = CreateObject("outlook.Application")
'Demande de l'adresse email du destinataire
Adresse = InputBox("Entrez une adresse Email ?", "Envoyer un Email")
'Crée un nouveau message
Set message = appOutlook.createitem(olMailItem)
With message 'paramétrons le message
.Subject = "ENVOYER UN MAIL A PARTIR D'EXCEL"
'Paramétrage du champ Objet :
.Body = "Ceci est le corps du message" & Chr(13) & "Cordialement" & Chr(13) & "Olivier"
'Paramétrage du corps du texte contenu et signature
.BodyFormat = olFormatHTML
'Choix du format du message ici html
.Recipients.Add (Adresse)
'Ajout de l'adresse dans le champ A...
ouverture = Application.GetOpenFilename( _
filefilter:="Fichiers Excel (*.xls),*.xls", _
Title:="Ouvrir", _
MultiSelect:=False)
Workbooks.Open ouverture
'Ouverture du classeur choisi pour être envoyé en pièce jointe
.Attachments.Add ouverture
'Paramétrage du champ Attaché :
.send
'Envoie du message
ActiveWorkbook.Close
'Fermeture du classeur choisi pour être envoyé en pièce jointe
End With
appOutlook.Quit
'fermeture de Outlook
Set appOutlook = Nothing
'J’ai du gérer l'erreur du au clic sur le bouton annuler du inputbox
sierreur:
MsgBox "Vous devez saisir une adresse Email" & Chr(10) _
& "puis cliquer sur OK", vbOKOnly + vbCritical, "ATTENTION"
End Sub