Outils logiciels pour les cours Paris II

Cours Paris II

Stages/ Thèses/ Séminaires

Laboratoire

edit SideBar

Cours 7

Marche aléatoire, Objets, Word, Recherche dichotomique, Projets

  • Marche Aléatoire

A l'intérieur du rectangle déterminé par les points (1,1) et (m,m). La valeur de m est entrée par le formulaire ainsi que le nombre d’itérations.

Attention au tirage qui doit être uniforme. La fonction Rnd() (ou Rnd) crée une valeur uniforme entre 0 et 1.

 L = CInt((Rnd * 4) + 0.5)  crée une valeur 1,2,3,4 avec probabilité 1/4.
 L = CInt((Rnd * 4) + 0.3)  crée une valeur 1,2,3,4 avec probabilité non uniforme.

Le programme est décomposé en 2 boutons et un champs texte:

 Private Sub CommandButton1_Click()
 ' Bouton d'itération   i: entre 0 et m
 ' Bouton d'itération   j: entre 0 et m
 ' On affiche le point i+1, j+1 dans le carré 1,m-1


 i = Cells(2, 1)
 j = Cells(1, 2)
 k = 1
 m = Cells(2, 2)
 Do While k <= Cells(1, 1) + 1
 ' Tirage aléatoire
 Randomize
 L = CInt((Rnd * 4) + 0.5)
 '  
 If L = 1 Then i = Abs(i - 1)
 If L = 2 Then i = 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
 Cells(i + 1, j + 1).Select
    With Selection.Interior
        .ColorIndex = 8
        .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
  • Tetris

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub a5()

  '  Couleurs bleu=5  blanc=2
   Dim i, n As Integer
   n = 10
   j = 1
   Do While j <= n
    Cells(j, 8).Select
      With Selection.Interior
     .ColorIndex = 2
     .Pattern = xlSolid
      End With

      Cells(j + 1, 8).Select
      With Selection.Interior
     .ColorIndex = 5
     .Pattern = xlSolid
      End With
      Sleep 100
      j = j + 1
  Loop
  End Sub
  • 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 dans un Tableau

Cette subroutine est essentielle pour tous les projets qui visent à traiter des mots.

Supposons que l’on place dans la colonne A un tableau de N mots triés, à partir de la ligne 2. La valeur de N est dans la cellule B1.

Exemple : N=4 et dans la colonne1:

 ab
 bb
 nn
 zz

On souhaite lire un mot à l’aide d’un formulaire. Si ce mot est dans le tableau, on afficher un message MsgBox ("Mot trouvé"). Sinon, on insère le mot dans le tableau, à l’aide de l’instruction

		Selection.EntireRow.Insert

L’insertion se fait au-dessus du mot sélectionné. Le tableau résultant doit TOUJOURS être trié.

La recherche se fait en comparant le mot s à insérer au point milieu du tableau (approximativement Cells(N/2,1)), puis en divisant l’intervalle de recherche par 2 à chaque itération.

Concevoir un Formulaire avec une zone de texte, et deux boutons (Next, Stop) sur le modèle ci-dessous.

Le Bouton 1 est NEXT et parcourt dichotomiquement le tableau. L’état du tableau est défini par le triplet (Bottom, i, N) qui décrit la decomposition possible en deux sous-tableaux. On s’arrête lorque N=i+1. Une difficulté est que soit Bottom+1=i, soit Bottom+2=i.

Si s est dans la partie basse, il faut donc comparer s à Cells(Bottom), Cells (Bottom+1) et peut-être Cellls(Bottom+2). Ce qui complique légèrement le programme.

 Private Sub CommandButton1_Click()
 s = Cells(1, 3)
 '
 ' Recherche S entre 1 et N de la colonne A2....AN+1.
 ' NT est le nombre d'éléments après la subroutine: NT=NT+1 (insertion) ou NT=N
 '
 '
 N = Cells(1, 2)
 NT = N
 Bottom = 1
 k = 1
 I = Bottom + CInt((N - Bottom) / 2)
 Cells(2, 3) = Bottom
 Cells(2, 4) = I
 Cells(2, 5) = N
 '
 ' Tant que La taille (N-i) du sous-tableau est > 2 on divise '
 '
 Do While (N - I > 1)

    If s < Cells(I + 1, 1) Then
    N = I

    ElseIf s = Cells(I + 1, 1) Then MsgBox ("Egalité")
    GoTo ExitEgalité
    Else: Bottom = I
    End If

 I = Bottom + CInt((N - Bottom) / 2)
 Cells(2 + k, 3) = Bottom
 Cells(2 + k, 4) = I
 Cells(2 + k, 5) = N
 k = k + 1
 Loop
 '
 ' La taille (N-i) du sous-tableau supérieur est maintenant = 2 donc N=i+1 ' Il faut regarder si s est dans le sous tableau inférieur de taille 2 ou 3.
 '

 If s = Cells(Bottom + 1, 1) Or s = Cells(Bottom + 2, 1) Or s = Cells(Bottom + 3, 1) Then
 MsgBox ("Egalitélimite")
 GoTo ExitEgalité

 ElseIf s < Cells(Bottom + 1, 1) Then Cells(Bottom + 1, 1).Select
 Selection.EntireRow.Insert
 Cells(Bottom + 1, 1) = s
 NT = NT + 1
 GoTo ExitEgalité

 ElseIf s < Cells(Bottom + 2, 1) Then Cells(Bottom + 2, 1).Select
 Selection.EntireRow.Insert
 Cells(Bottom + 2, 1) = s
 NT = NT + 1
 GoTo ExitEgalité

 ElseIf s < Cells(Bottom + 3, 1) Then
 Cells(Bottom + 3, 1).Select
 Selection.EntireRow.Insert
 Cells(Bottom + 3, 1) = s
 NT = NT + 1
 GoTo ExitEgalité

 End If

 ' Ou si s est dans le tableau supérieur
 ' On insère une nouvelle ligne si nécessaire et place s '
 ' Attention : il faut un saut de ligne après le Then…..du If   (ce problème créait les difficultés lors du TD du 14
 ' Novembre). Une erreur
  ' de compilation était générée au niveau du ElseIf……

 If s = Cells(I + 1, 1) Or s = Cells(N + 1, 1) Then
 MsgBox ("Egalitélimite")
 GoTo ExitEgalité

 ElseIf s < Cells(I + 1, 1) Then Cells(I + 1, 1).Select
 Selection.EntireRow.Insert
  Cells(I + 1, 1) = s
 NT = NT + 1
 GoTo ExitEgalité

 ElseIf s < Cells(N + 1, 1) Then Cells(N + 1, 1).Select
 Selection.EntireRow.Insert
 Cells(N + 1, 1) = s
 NT = NT + 1
 GoTo ExitEgalité

 Else: Cells(N + 2, 1).Select
 Selection.EntireRow.Insert
  Cells(N + 2, 1) = s
 NT = NT + 1
 End If

 ExitEgalité:
 Cells(1, 2) = NT
 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()
 Range("C1").Value = TextBox1.Value
 End Sub
  • Projets Type: rendre un fichier .pdf suivant le schéma ci-joint
    Projet à rendre (exemple) .pdf 
    Projet à rendre (exemple) .docx

Voir la liste des projets possibles.

Fichier Excel avec les macros: marche aléatoire, lecture fichier Word, Parcours du fichier

Fichier Excel avec les macros: recherche dichotomique et insertion

UP2