Formulaire Dans Excel – Bipbipcoyote 2000

Sauver le contenu dans Excel

Alors, conditions préalables
Le diaporama et le fichier Excel sont dans le même dossier
On note en A1 de la Feuil1 la mention "Noms" et en B1 "Prénoms", cela est nécessaire car on va compter le nombre de lignes déjà remplies dans le fichier Excel
On utilise la Feuil1 pour enregistrer ce que l'utilisateur entre comme données. Il faudra sans doute retraiter ces données car les utilisateurs peuvent faire des erreurs, comme des informations incomplètes ou en double etc....
C'est la situation de départ,
ici, nous considérons un diaporama avec 3 dias et il y a deux textbox's sur la première où l'on demande le nom et le prénom ( qui l'eût cru) ...
Sur la 3ème on a un bouton pour sauver les données et revenir sur la dia 1 en réinitialisant le diaporama

Sur le bouton que l'on a pris soin de renommer on a le code

Private Sub cmd_CopierVersExcel_Click()
    Call Ouvrir
End Sub

Et on a un module qui contient

Sub Ouvrir() 'ouvre et copie les données dans un fichier Excel nommé Sauvegarde.xls
Dim xlApp As Object
Dim Chemin As String
Dim Document As Variant
Dim Compteur As Long

'on initialise le compteur = nombre de lignes remplies
Compteur = 0

'endroit où se trouve les fichiers
Chemin = ActivePresentation.Path

'on lance Excel
Set xlApp = CreateObject("excel.application")
'on masque l'application
xlApp.Visible = False
Document = Dir(Chemin & "\Sauvegarde.xlsx")
'on masque ce qui se passe dans excel
xlApp.EnableEvents = False
'on charge le classeur
    xlApp.Workbooks.Open FileName:=Chemin & "\" & Document, UpdateLinks:=True, ReadOnly:=False
'on compte le nombre de lignes déjà remplies
    Compteur = xlApp.ActiveSheet.UsedRange.Rows.Count
'on copie le contenu des textbox dans les cellules
    xlApp.Range("A" & Compteur + 1) = ActivePresentation.Slides(1).Shapes("TextBox1").OLEFormat.Object.Text
    xlApp.Range("B" & Compteur + 1) = ActivePresentation.Slides(1).Shapes("TextBox2").OLEFormat.Object.Text
xlApp.EnableEvents = True
'on sauve le fichier excel
xlApp.Workbooks("Sauvegarde.xlsx").Save
'on quitte Excel
xlApp.Quit

'On revient dans la présentation
DoEvents
CommandBars.ExecuteMso ("SlideReset")
DoEvents
ActivePresentation.SlideShowWindow.Activate

'Effacement des données saisies précédemment sur la dia
For i = 1 To 2
 ActivePresentation.Slides(1).Shapes("TextBox" & i).OLEFormat.Object.Text = ""
Next
'On revient sur la première dia
SlideShowWindows(1).View.GotoSlide (1)

End Sub

Télécharger le fichier PowerPointToExcel.zip

Sauver le contenu dans Excel

Avertissement