|
Outils logiciels pour les cours Paris II
Cours Paris II
Stages/ Thèses/ Séminaires |
Cours 7Marche aléatoire, Objets, Word, Recherche dichotomique, Projets
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
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
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 :
Sub Lire() ' ' Macro2 Macro ' Macro enregistrée le 17/10/2007 par LRI ' Application.Workbooks.Add "C:\paris2\ac.xls" End Sub
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 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
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
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
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 |