Bonjour à tous,
Je travaille sur un diaporama PowerPoint qui est un Qcm.
Sur la dernière diapo, une macro est exécutée. Son but est d'aller écrire sur Excel dans un fichier existant.
La macro fonctionne comme je le désire tant qu'Excel n'est pas ouvert, mais si elle est executée alors qu'excel est déjà ouvert, rien n'est écrit sur le fichier Excel.
Il n'y a aucun plantage, la macro va jusqu'au bout mais à à partir de la ligne indiquée ('*****PROBLÈME A PARTIR D'ICI***) sur le code joint, il ne se passe rien sur Excel.
Merci de votre aide
Francis
Je travaille sur un diaporama PowerPoint qui est un Qcm.
Sur la dernière diapo, une macro est exécutée. Son but est d'aller écrire sur Excel dans un fichier existant.
La macro fonctionne comme je le désire tant qu'Excel n'est pas ouvert, mais si elle est executée alors qu'excel est déjà ouvert, rien n'est écrit sur le fichier Excel.
Il n'y a aucun plantage, la macro va jusqu'au bout mais à à partir de la ligne indiquée ('*****PROBLÈME A PARTIR D'ICI***) sur le code joint, il ne se passe rien sur Excel.
Merci de votre aide
Francis
Code:
Sub Fin2()
Dim XlApp As Excel.Application 'Déclaration de la variable qui fera référence à Excel
Dim XlClasseur As Excel.Workbook 'Déclaration de la variable qui fera référence au classeur
Dim ExcelOuvert As Boolean, ClasseurOuvert As Boolean
ExcelOuvert = False
ClasseurOuvert = False
Total = 3
Question = 3
Fichier = "Titi"
'La boîte de dialogue
x = MsgBox("Vous avez répondu correctement à " & Total & " questions sur " & Question - 1 & "." _
& Chr(13) & "Vous avez donc " & Int(Total / (Question - 1) * 100) & "% des points." _
& Chr(13) & "Cliquez sur le bouton OK", , "Fin du questionnaire")
Fichier = Nom & ".txt"
'*******Test Excel déjà ouvert
On Error Resume Next
Set XlApp = GetObject(, "Excel.Application")
If XlApp Is Nothing Then
Set XlApp = CreateObject("Excel.Application")
Set XlClasseur = XlApp.Workbooks.Open("C:\Temp\RésultatsQCM.xlsx")
ExcelOuvert = False
Else
'******Si Excel ouvert test si classeur ouvert
For i = 1 To XlApp.Workbooks.Count
If XlApp.Workbooks(i).Name = "RésultatsQCM.xlsx" Then
ClasseurOuvert = True
Exit For
End If
Next i
If ClasseurOuvert = True Then
Workbooks("RésultatsQCM.xls").Activate
'MsgBox "resultat ouvert"
ExcelOuvert = True
Else
Set XlClasseur = XlApp.Workbooks.Open("C:\Temp\RésultatsQCM.xlsx")
ExcelOuvert = True
End If
End If
'****** Travail sur excel
XlApp.Visible = True
'xcl.Parent.Windows(1).Visible = True
XlClasseur.Worksheets(1).Select
'**************PROBLEME A PARTIR D'ICI********
'Si excel est ouvert Rien n'est écrit dans Excel
'Recherche de la cellule contenant moyenne
Cells.Find(What:="moyenne").Select
'Insertion d'une colonne pour introduire les résultats
Selection.EntireColumn.Insert
ActiveCell.Value = Nom
ActiveCell.Offset(1, 0).Range("A1").Select
'Introduction des données dans la feuille de calcul
For i = 1 To Question - 1
ActiveCell.Value = Points(i)
ActiveCell.Offset(1, 0).Range("A1").Select
Next i
XlClasseur.Save 'Enregistrement du fichier Excel
XlClasseur.Close
'Fermeture d'Excel s'il n'était pas ouvert
If ExcelOuvert = False Then XlApp.Quit
Set XlApp = Nothing
'Deuxième sauvegarde des résultats dans un fichier texte
'portant comme nom celui de la personne qui a répondu au questionnaire
Open Fichier For Output Shared As #1
Write #1, Nom
For i = 1 To Question - 1
Write #1, Points(i)
Next i
Close #1
End Sub
