[VBA-Excel-powerpoint] copie données dans powerpoint puis export pdf plante

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
Butters
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 9 janvier 2017
Version d'Excel : 2016 FR

Message par Butters » 17 mai 2019, 13:40

Bonjour,

J'ai créé une macro qui prend des variables dans une ligne de tableau excel, les utilise pour compléter une diapo powerpoint, puis exporte cette diapo (avec 3 autres) en pdf. Avec une boucle pour répéter pour chaque ligne du tableau. (voir code ci-dessous)

La macro fonctionne, mais de temps en temps elle plante avec le code 462 : le serveur distant n'existe pas ou n'est pas disponible. Tout ça alors que je n'ai que 4 ligne dans le tableau lors de mes tests, et que le même tableau plante des fois et d'autres non.

J'ai l'impression que c 'est dû à un lag, et que la macro n'aime pas attendre et donc s'arrête si c'est trop long, mais peut être que je me trompe.

Est-ce que vous auriez des idéés pour fiabiliser le code ? quelque chose pourrait être mieux écrit ?

Ci dessous le-dit code :
' Variables de navigation dans le tableau
Dim i As Integer, Total As Integer

'Total est le nombre de rapports à envoyer (ie nombre de participants valides)
For Total = 2 To 1000
    If ActiveSheet.Cells(Total, 1).Value = "" Then
        Exit For
    Else
    End If
Next

'Variables de comptage de champs non rempli
Dim CountActivite As Integer, CountDuree As Integer, CountResultat As Integer
'Comptage de champs non remplis
CountActivite = 0
CountDuree = 0
CountResultat = 0
For i = 2 To Total - 1
    If ActiveSheet.Cells(i, 9).Value = "" Then
        CountActivite = CountActivite + 1
    Else
    End If
    If ActiveSheet.Cells(i, 10).Value = "" Then
        CountDuree = CountDuree + 1
    Else
    End If
    If ActiveSheet.Cells(i, 11).Value = "" Then
        CountResultat = CountResultat + 1
    Else
    End If
Next

'La macro s'arrête s'il manque des infos
If CountActivite > 0 Or CountDuree > 0 Or CountResultat > 0 Then
    MsgBox "Veuillez remplir tous les champs correspondants de l'activité pratiquée par les participants, leur durée et le résultat de la mesure." & Chr(10) & "Si un participant s'est inscrit à la séance mais n'est pas venu, supprimez totalement la ligne correspondant." & Chr(10) & "Nombre de champs vacants : " & CountActivite + CountDuree + CountResultat, vbCritical, "Erreur : champ(s) vacant(s)"
    Exit Sub
Else
End If

Dim DateSeance As String
DateSeance = ActiveSheet.Name
If Len(DateSeance) <> 8 Then
    MsgBox "Le nom de l'onglet ne correspond pas à une date au format AAAAMMJJ, veuillez le corriger avant de réessayer", vbCritical
    Exit Sub
Else
    If MsgBox("La date de la séance est bien le " & Right(DateSeance, 2) & "/" & Mid(DateSeance, 5, 2) & "/" & Left(DateSeance, 4), vbYesNo, "Date de la séance") = vbNo Then
        MsgBox "Le nom de l'onglet ne correspond pas à une date au format AAAAMMJJ, veuillez le corriger avant de réessayer", vbCritical
        Exit Sub
    Else
    End If
End If



'Variables d'input à utiliser dans le rapport ou pour envoyer le mail
Dim Prenom As String, Nom As String, Mail As String, Paiement As String, Activite As String, Duree As String, Resultat As Integer

'chemin du dossier courrant
Dim Chemin As String
Chemin = Application.ActiveWorkbook.Path

'créer le répertoire pour les exports
If Len(Dir(Chemin & "\" & DateSeance, vbDirectory)) > 0 Then
    MsgBox "Le dossier de sauvegarde existe déjà, veuillez verifier que vous avez saisi la bonne date, ou veuillez supprimer le dossier portant le nom : " & DateSeance, vbCritical
    Exit Sub
Else
    MkDir (Chemin & "\" & DateSeance)
End If

'Ouvrir powerpoint et le fichier modele
Dim ppt As PowerPoint.Application
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True ' Indispensable, sinon il ne peut pas ouvrir de fichier (Erreur)
Dim Pres As PowerPoint.Presentation
Set Pres = ppt.Presentations.Open(Filename:=Chemin & "\Rapport.pptx")

'Pour chaque participant
For i = 2 To Total - 1
    
'Attribution des valeurs d'input
    Prenom = ActiveSheet.Cells(i, 3).Value
    Nom = ActiveSheet.Cells(i, 4).Value
    Mail = ActiveSheet.Cells(i, 2).Value
    Paiement = ActiveSheet.Cells(i, 8).Value
    Activite = ActiveSheet.Cells(i, 9).Value
    Duree = ActiveSheet.Cells(i, 10).Value
    Resultat = ActiveSheet.Cells(i, 11).Value
    
'Modification du powerpoint
    'nouvelle slide créée, slide(1) reste le modele
    Pres.Slides(i - 1).Duplicate
    
    'insert des input dans la slide(i)
    Pres.Slides(i).Shapes("ZoneNomDate").TextFrame.TextRange.Text = Prenom & " " & Nom & Chr(10) & Right(DateSeance, 2) & "/" & Mid(DateSeance, 5, 2) & "/" & Left(DateSeance, 4)
    If Left(Activite, 1) = "A" Or Left(Activite, 1) = "E" Or Left(Activite, 1) = "I" Or Left(Activite, 1) = "O" Or Left(Activite, 1) = "U" Or Left(Activite, 1) = "Y" Then
        Pres.Slides(i).Shapes("ZoneActivite").TextFrame.TextRange.Text = Duree & " d'" & Activite
    Else
        Pres.Slides(i).Shapes("ZoneActivite").TextFrame.TextRange.Text = Duree & " de " & Activite
    End If
    Pres.Slides(i).Shapes("ZoneResultat").TextFrame.TextRange.Text = CStr(Resultat)
    If Resultat < 30 Then
        Pres.Slides(i).Shapes("ZoneComment").TextFrame.TextRange.Text = "texte 1"
    ElseIf Resultat < 60 Then
        Pres.Slides(i).Shapes("ZoneComment").TextFrame.TextRange.Text = "texte 2"
    ElseIf Resultat < 100 Then
        Pres.Slides(i).Shapes("ZoneComment").TextFrame.TextRange.Text = "texte 3"
    Else
        Pres.Slides(i).Shapes("ZoneComment").TextFrame.TextRange.Text = "texte 4"
    End If
    Pres.Slides(i).Shapes("jauge").Rotation = Int(Resultat * 3 / 2) + 1
    
'Export du rapport en pdf
   Dim PrintedSlide As PrintRange
   Pres.PrintOptions.Ranges.ClearAll
   Set PrintedSlide = Pres.PrintOptions.Ranges.Add(Start:=i, End:=i + 3)
   Pres.ExportAsFixedFormat Path:=Chemin & "\" & DateSeance & "\" & Nom & "-" & Prenom & ".pdf", FixedFormatType:=ppFixedFormatTypePDF, intent:=ppFixedFormatIntentPrint, PrintRange:=PrintedSlide, RangeType:=ppPrintSlideRange
    
    
Next
'enregistrer le powerpoint sous le repertoire créé, et donc ne pas toucher au modèle
Pres.SaveAs Filename:=Chemin & "\" & DateSeance & "\" & DateSeance & "-rapport.pptx"
Merci ! :mrgreen:
B
Butters
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 9 janvier 2017
Version d'Excel : 2016 FR

Message par Butters » 21 mai 2019, 16:00

Personne n'est inspiré ? ::(

Info supplémentaire, quand il y a plantage, c'est pendant que des barres d'avancement d'export en pdf sont à l'écran (elles se succèdent pour chaque export), peut être que si ça se faisait en tache de fond sans feedback à l'écran ça se passerait mieux, mais je ne sais pas comment faire...
B
Butters
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 9 janvier 2017
Version d'Excel : 2016 FR

Message par Butters » 3 juin 2019, 14:37

Toujours personne ?
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message