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
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