Cours 10

VBA et Office

VBA permet d'interagir avec les objets Office (Word, Access, Powerpoint, Outlook). Toutes les manipulations entre ces composants peuvent se faire par VBA.

Les objets VBA
- Classes simples

Public Type Contactclass

    Nom As String
    Prenom As String
    Adresse As String
    CP As String
    Localite As String
    DateNaissance As Date

End Type Sub UtiliserContact()

    Dim Contact As Contactclass

    With Contact
        .Nom = "Smith"
        .Prenom = "John"
        .Adresse = "Norfolk street"
        .CP = "10002"
        .Localite = "NY"
        .DateNaissance = DateSerial(1920, 12, 18)
    End With

    AfficherMessage Contact

End Sub

Sub AfficherMessage(ByRef Contact As Contactclass)

    With Contact
        MsgBox "Bonjour " & .Prenom & " " & .Nom & "." & vbCrLf & _
            "Vous habitez " & .Adresse & " à " & .CP & " " & .Localite & "." & vbCrLf & _
            "Vous êtes né le " & Format(.DateNaissance, "dddd dd mmmm yyyy"), vbOKOnly, "Salutations"
    End With

End Sub

modules de classe
- Insertion module de classe: cc par exemple avec la description:

 Public Nom As String
 Public Prenom As String
 Public Adresse As String
 Public CP As String
 Public Localite As String
 Public DateNaissance As Date
 Public Sexe As String

Utilisation

Sub UtiliserContactcc()

    Dim Contact As New cc

    With Contact
        .Nom = "Smith"

        .Localite = "NY"
        .DateNaissance = DateSerial(1906, 12, 25)
        .Sexe = "masculin"
    End With

    AfficherMessageContactcc Contact

End Sub

Sub AfficherMessageContactcc(Contact As cc)

    With Contact
        MsgBox "Bonjour " & .Prenom & " " & .Nom & "." & vbCrLf & _
            "Vous habitez " & .Adresse & " à " & .CP & " " & .Localite & "." & vbCrLf & _
            "Vous êtes né le " & Format(.DateNaissance, "dddd dd mmmm yyyy") & ".", vbOKOnly, "Salutations"
    End With

End Sub

Envoyer un email par VBA avec des objets Outlook

Au cours 8, nous avons vu comment lire un fichier Word et considérer les lignes du fichier, tous les mots du fichier, comme des objets de base. Nous décrivons maintenant comment envoyer un email par Outlook à partir de VBA.

Nous construisons des objects pour les adresse emails, le titre, le contenu et les fichiers attachés. L'ensemble consituera un objet Outlook.

 Sub UseOutlook()
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)
  MonMessage.to = "mdr@free.fr"
  MonMessage.cc = "mdr@lri.fr"
 '  MonMessage.bcc = "un.copain@supermail.com;une-amie@hotmail.com"
 '  MonMessage.Attachments.Add "C:\Mes Documents\Zoulie Image.gif"
 '  MonMessage.Attachments.Add "D:\Prof\Janvier\Base clients.mdb"
  MonMessage.Subject = "Je suis content"
  ' Le corps du message est divisé en 2 lignes :
  Corps = "Bonjour,"
  ' Chr(13) & Chr(10) = Touche ENTER
  Corps = Corps & Chr(13) & Chr(10)
  Corps = Corps & "Je vous envoie un message idiot."
  MonMessage.body = Corps
  MonMessage.send
  Set MonOutlook = Nothing
 End Sub

Représentation d'une distribution : loi uniforme

Certains des projets consistent à afficher une distribution, à l'aide d'une marche aléatoire. On compte à l'aide du tableau count(1000) le nombre d'occurences en chaque position. La valeur count(i) est le nombre de fois où on atteint la position (50,i).

On affiche par paquets de 10 en coloriant (50-Count(i)/10, i).

 Private Sub CommandButton1_Click()
 Dim count(1000) As Integer
 Dim q As Integer
 ' La marche part du point (50,50) et se déplace horizontalement avec proba 1/2 à gauche et à droite


 i = 50
 j = 50
 k = 1
 m = Cells(2, 2)
 Do While k <= Cells(1, 1) + 1
 ' Randomize
 L = CInt((Rnd * 2) + 0.5)
 If L = 1 Then i = Abs(i - 1)
 If L = 2 Then i = i + 1
 count(i) = count(i) + 1

 ' If L = 3 Then j = Abs(j - 1)
 ' If L = 4 Then j = j + 1

 ' If i > m Then i = m - 1
 ' If j > m Then j = m - 1

 q = count(i) / 10
 Cells(Abs(j - q), i + 1).Select
    With Selection.Interior
        .ColorIndex = 7
        .Pattern = xlSolid
    End With



 k = k + 1
 Loop
 Cells(2, 1) = i
 Cells(1, 2) = j

 End Sub

 Private Sub CommandButton2_Click()
 ' Bouton QUITTER
 ' Masquer Userform1
   UserForm1.Hide
 ' Récupérer la mem. occupée par userform1
   Unload UserForm1

 End Sub

 Private Sub TextBox1_Change()
 Cells(1, 1) = TextBox1.Value
 End Sub

 Private Sub TextBox2_Change()
 Cells(2, 2) = TextBox2.Value
 End Sub

Insertion de graphiques

Sub CreateChart()

'PURPOSE: Create a chart (chart dimensions are required)

Worksheets(3).Activate Dim rng As Range Dim cht As ChartObject

'Your data range for the chart

  Set rng = ActiveSheet.Range("D5:E8")

'Create a chart

  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=450, _
    Top:=ActiveCell.Top, _
    Height:=250)

'Give chart some data

  cht.Chart.SetSourceData Source:=rng

'Determine the chart type

  cht.Chart.ChartType = xlXYScatterLines

End Sub

Fichier Excel avec les macros: Classes

Fichier Excel avec les macros: UseOutlook

Fichier Excel avec les macros: affichage d'une distribution

UP2