Microsoft 365 ouverture fichier pptx sur sharepoint (vba)

lesoldat9

XLDnaute Occasionnel
Bonjour à tous,

Mon fichier fonctionner très bien quand il était sur mon bureau mais maintenant qu'il est sur sharepoint ca ne fonctionne plus je vous met mon code ici:

Private Sub CommandButton1_Click()

Dim LienAgence As String
Dim Nomfichier1 As String
Set monapplication = CreateObject("Shell.Application")

Application.ScreenUpdating = False
LienAgence = ThisWorkbook.Path
Nomfichier1 = "Livret d'accueil Intérim.pptx"
Nomfichier2 = "Livret d'accueil Intérim 2.pptx"




derniereLigne = ThisWorkbook.Sheets("Données").Cells(Rows.Count, 5).End(xlUp).Row + 1

If Me.OptionButton1.Value = True Then
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 5).Value = OptionButton1.Caption
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 1).Value = Date
End If

If Me.OptionButton2.Value = True Then
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 5).Value = OptionButton2.Caption
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 1).Value = Date
End If

If Me.OptionButton5.Value = True Then
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 5).Value = OptionButton5.Caption
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 1).Value = Date
End If


Cancel = OptionButton1 + OptionButton2 + OptionButton5 = 0
If Cancel Then
MsgBox "Veuillez sélectionner un poste ..."
Exit Sub
End If

If Me.OptionButton3.Value = True Then
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 7) = Me.OptionButton3.Caption
UserForm1.Hide
ThisWorkbook.Sheets("Données").Range("AE2").Value = ThisWorkbook.Sheets("Données").Range("AE2").Value + 1
Exit Sub

End If

If Me.OptionButton4.Value = True Then
ThisWorkbook.Sheets("Données").Cells(derniereLigne, 7) = Me.OptionButton3.Caption
End If


If Me.OptionButton2.Value = True Then
UserForm1.Hide
monapplication.Open (LienAgence & Nomfichier2)

Else
UserForm1.Hide
monapplication.Open (LienAgence & Nomfichier1)
End If


If Cells(derniereLigne, 3) <> "" Then
UserForm3.Show
End If


ThisWorkbook.Sheets("Données").Range("AE2").Value = ThisWorkbook.Sheets("Données").Range("AE2").Value + 1


Application.ScreenUpdating = True


End Sub
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    40.7 KB · Affichages: 17

Discussions similaires

Statistiques des forums

Discussions
312 095
Messages
2 085 248
Membres
102 835
dernier inscrit
Alexandrax971