• View
• Edit
• History
• Print

Cours 8

Objets

A chaque application Office correspond une hiérarchie d'objets organisée selon une structure d'arbre. Pour chaque objet, il a des propriétés : ces propriétés sont des variables qui peuvent être des types de base (un classeur a un nom, variable de type String), des types Objets (un classeur dispose d'un objet VBProject) ou des collections de type objets (un classeur a un attribut Worksheets qui est une liste de feuilles).

Les méthodes sont des comportements pour l'objet (save pour un classeur par exemple). Pour des raisons de compatibilité des versions successives, les modèles objets successifs ne présentent pas énormément de différences. Quelques exemples de syntaxe :

Préliminaires: Outils->Références->Cliquez sur 4 Biliothèques dont Microsoft Word 12.0 Object Library

Exemples :

• Lire un fichier Excel externe.

  Sub Lire()
  '
  ' Macro2 Macro
  ' Macro enregistrée le 17/10/2007 par LRI
  '
  Application.Workbooks.Add "C:\paris2\ac.xls"
  End Sub

• Lire un fichier Word et placer les mots dans la 1ère colonne

 Sub lireword()
 '
 ' Macro pour lire le 1er mot du fichier aa.doc qui doit ETRE FERME', puis tous les mots.
 ' Macro enregistrée le 01/11/2006 par  mdr
 '

Dim i, NbreMots As Long

  Dim WdApp As Word.Application
    Set WdApp = New Word.Application

    With WdApp
            .Documents.Open Filename:="C:\paris2\aa.doc"
            With .Selection
                .EndKey Unit:=wdStory
                .TypeParagraph
            End With
        .ActiveDocument.Save
        .Visible = True
        Cells(1, 2) = .ActiveDocument.Words.First
        Cells(2, 2) = .ActiveDocument.Words.Last
  '   On trouve le nombre de mots
        NbreMots = .ActiveDocument.Words.Count
  '   On écrit les mots dans la colonne A
        For i = 1 To NbreMots
        Cells(i, 1) = .ActiveDocument.Words(i)
        Next i


    End With
 WdApp.Quit
 Set WdApp = Nothing

 End Sub

• Parcours linéaire des mots

Trois boutons: OUI, NON, STOP

 Sub Main()
 Cells(1, 4) = 1
 Cells(1, 3) = Cells(1, 1)

 UserForm1.Show

 End Sub
 Sub CommandButton1_Click()
 I1 = Cells(1, 4)
 Cells(I1, 1).Select
 With Selection.Interior
 .ColorIndex = 5
 .Pattern = xlSolid
 End With

 I1 = I1 + 1
 Cells(1, 4) = I1
 Cells(1, 3) = Cells(I1, 1)
  End Sub


    Private Sub CommandButton2_Click()
 I1 = Cells(1, 4)
 Cells(I1, 1).Select
 With Selection.Interior
 .ColorIndex = 8
 .Pattern = xlSolid
 End With
 I1 = I1 + 1
 Cells(1, 4) = I1
 Cells(1, 3) = Cells(I1, 1)
  End Sub
  Private Sub CommandButton3_Click()
  ' Bouton QUITTER
  ' Masquer Userform1
   UserForm1.Hide
  ' Récupérer la memoire occupée par userform1
   Unload UserForm1
  End Sub

• Recherche dichotomique à l'aide d'Objets

Rechercher sur une colonne une valeur: si elle n'est pas présente, l'insérer en maintenant la liste triée.

 'insertion dans la colonne A de la feuille 2, de mots entrés  à l'aide de InputBox
 ' tableau à partir de ligne 2, taille du tableau en B1

 Public Sub insertion()
 Worksheets(2).Activate

 Dim premligne, derligne, lireligne As Double
 Dim valeurcherchee As String
 premligne = 2
 derligne = Cells(1, 2) + 1

 valeurcherchee = InputBox("valeur cherchée")

 While premligne <> derligne - 1
    lireligne = Int((premligne + derligne) / 2)
    Range("A" & lireligne).Select
    If Selection = valeurcherchee Then
        MsgBox ("trouvee en " + CStr(lireligne))
        Exit Sub
        Else
        If Selection > valeurcherchee Then
            derligne = lireligne
            Else
            premligne = lireligne
        End If
    End If
 Wend

 If Range("A" & premligne).Value = valeurcherchee Then
    MsgBox ("trouvé en " + premligne)
    Else
    If Range("A" & derligne).Value = valeurcherchee Then
        MsgBox ("trouvé en " + derligne)
        Else
    'check  < than first
        If Range("A2").Value > valeurcherchee Then
        premligne = 1
        End If
    ' check > last
     If Range("A" & derligne).Value < valeurcherchee Then
     premligne = derligne
     End If
     'general case :insertion just after premligne

  Cells(premligne + 1, 1).Select
    Selection.EntireRow.Insert
     Cells(premligne + 1, 1) = valeurcherchee
     Cells(1, 2) = Cells(1, 2) + 1

        ' MsgBox ("Non trouvé")
    End If
  End If
  End Sub

Fichier Excel avec les macros: lectures fichier Word, parcours des mots avec un formulaire, insertion de certains mots dans une liste triée

Données boursières: stratégie aléatoire

Fichier f1.docx Fichier f2.docx Fichier f3.docx