Club Informatique Longueuil
Retour

  Suite à l'atelier sur le VBA 

Suite au super atelier du samedi le 24 janvier sur le VBA sous Excel, vous trouverez ci- joint le texte remis et quelques lignes de codes analysés. Amusez-vous bien.

Texte de référence : cliquez ici.

Code analysé :

Exercice sur la création d'un tableau croisé à partir de l'assemblage de plusieurs fichiers.

Sub Ouvrir1()
'
' ouvre un fichier spécifique

Workbooks.Open Filename:= _
"C:\Documents and Settings\Pierre\Bureau\Dossier VBA\liste1.xls"
End Sub
 

Sub Ouvrir2()
'
' demande le nom du fichier à ouvrir

fichier = InputBox("entrez le nom du fichier")
ChDir "C:\Documents and Settings\Pierre\Bureau\Dossier VBA"
Workbooks.Open Filename:=fichier
End Sub

Sub Ouvrir3()
'
' affiche la boîte de dialogue Ouvrir

Application.Dialogs(xlDialogOpen).Show
End Sub

Sub Ouvrir4()
'
' Ouvre autant de fichiers que nécessaire
'
' question y a-t-il un autre fichier à importer ?
rep = MsgBox("Y a-t-il un autre fichier à importer ?", vbYesNo, "On continue ?")
Do While rep = 6
Application.Dialogs(xlDialogOpen).Show
rep = MsgBox("Y a-t-il un autre fichier à importer ?", vbYesNo, "On continue ?")

Loop
End Sub

Sub Ouvrir5()
'
' ouvre tous les fichiers contenus dans un dossier
chemin = InputBox("Entrez le chemin du dossier contenant les fichiers")
fichier = Dir(chemin & "*.xls")
' traitement
traitement:
ChDir chemin
Workbooks.Open Filename:=fichier

' autre lecture
fichier = Dir
If fichier <> "" Then
GoTo traitement
End If
End Sub

Sub vide()
' efface toutes lignes sauf la première

' Trouve la dernière ligne
Range("A1").Select
Selection.End(xlDown).Select
derniereligne = ActiveCell.Row

' Efface toutes les données
Rows("2:" & derniereligne).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
End Sub

Sub assemble()
'
' Assemble à la suite plusieurs fichiers dans un classeur.
' Crée un tableau croisé à partir des données obtenues
'
' place le curseur en a2
Range("a2").Select

' question y a-t-il un autre fichier à importer ?
rep = MsgBox("Y a-t-il un fichier à importer ?", vbYesNo, "On continue ?")
Do While rep = 6
Application.Dialogs(xlDialogOpen).Show
nomdefichier = ActiveWorkbook.Name

' trouve la dernière ligne
Range("a1").Select
Selection.End(xlDown).Select
dernièreligne = ActiveCell.Row

' sélectionne la région à copier
Range("a2:f" & dernièreligne).Select

' copie la région
Selection.Copy

' change de fichier
Windows("Exercices VBA.xls").Activate
ActiveSheet.Paste

' ferme le fichier sans faire de changement
Windows(nomdefichier).Activate
ActiveWindow.Close


' place le curseur sous les données
Windows("Exercices VBA.xls").Activate
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

' doit-on continuer ?
rep = MsgBox("Y a-t-il un autre fichier à importer ?", vbYesNo, "On continue ?")
Loop

' crée le tabelau croisé
'
' Trouve la dernière ligne
Range("a1").Select
Selection.End(xlDown).Select
dernièreligne = ActiveCell.Row

' crée le tableau

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Feuil1!R1C1:R" & derniereligne & "C6").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
Array("Client", "Données")
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Prêt à emballer")
.Orientation = xlDataField
.Position = 1
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"À commander")
.Orientation = xlDataField
.Position = 2
End With
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Total"). _
Orientation = xlDataField
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "", _
xlDataAndLabel, True
ActiveSheet.PivotTables("Tableau croisé dynamique1").Format xlReport3
Columns("D:D").ColumnWidth = 13#

' trouve la dernière ligne du tableau
Range("a1").Select
Selection.End(xlDown).Select
dernièreligne = ActiveCell.Row

Range("B" & derniereligne & ":D" & derniereligne).Select
With Selection
.HorizontalAlignment = xlRight
End With
Range("A2").Select
End Sub

Exercice sur la création d'un formulaire de bulletin de vote.

Private Sub CommandButton1_Click()
' transfert les données du formulaire sur la feuille de base de données
'
' trouve la première ligne vide
Range("A1").Select
Selection.End(xlDown).Select
derniereligne = ActiveCell.Row + 1

' transfert des informations
Range("a" & derniereligne).Value = TextBox1.Text
If OptionButton1.Value Then
Range("b" & derniereligne).Value = 1
Else
Range("b" & derniereligne).Value = 0
End If
If OptionButton2.Value Then
Range("c" & derniereligne).Value = 1
Else
Range("c" & derniereligne).Value = 0
End If
If OptionButton3.Value Then
Range("d" & derniereligne).Value = 1
Else
Range("d" & derniereligne).Value = 0
End If

' remise à zéro des boutons
TextBox1.Text = ""
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False

End Sub

Private Sub CommandButton2_Click()
' remise à zéro des boutons
TextBox1.Text = ""
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False

End Sub

Private Sub CommandButton3_Click()
' fermeture de la fenêtre
Me.Hide

End Sub
 
Retour