Bonsoir à tous,
je bloque sur un code...
avec de l'aide j'ai pu réaliser le code qui suit pour créer un classeur excel XLSX à partir d'un classeur modèle et d'un classeur XLSM de base.
je souhaiterais l'adapter pour créer un classeur excel XLSM à partir d'un classeur modèle, mais ça bloque à la ligne rouge (n°47) et je trouve pas pourquoi....
merci du temps que vous m'accorderez
je bloque sur un code...
avec de l'aide j'ai pu réaliser le code qui suit pour créer un classeur excel XLSX à partir d'un classeur modèle et d'un classeur XLSM de base.
je souhaiterais l'adapter pour créer un classeur excel XLSM à partir d'un classeur modèle, mais ça bloque à la ligne rouge (n°47) et je trouve pas pourquoi....
VB:
' CREATION AUTOMATIQUE DES FICHIERS EXCEL DE POINTAGE
' code à reprendre
'
Option Explicit
Private moFSO As FileSystemObject
Public Sub GenererFiche(piLig As Integer)
Dim iRep As VbMsgBoxResult
Dim sModele As String
Dim oShSource As Worksheet
Dim oWBFinal As Workbook
Dim oShFinal As Worksheet
Dim sNom As String
Dim sFichierFinal As String
sModele = ThisWorkbook.Path & "\Modèles\modèle.xlsm" 'emplacement du modèle
If Dir(sModele) = "" Then
MsgBox "Modèle absent : " & vbCrLf & sModele, vbExclamation
Exit Sub
End If
Set oShSource = Worksheets("Récapitulatif Suivi des Heures")
sNom = oShSource.Range("E" & piLig).Value 'aller chercher le nom du fichier à créer dans la colonne L
sFichierFinal = ThisWorkbook.Path & "\Suivi RH - Congés et Heures\" & oShSource.Range("D" & piLig).Value & "\Pointage des heures\" & sNom & " - pointage.xlsm" 'créer le fichier excel à l'emplacement avec le nom trouvé
If Dir(sFichierFinal) = "" Then
iRep = MsgBox("Voulez-vous générer la fiche de pointage pour " & sNom & " ?", vbOKCancel + vbExclamation) 'boite de dialogue demande si on veut générer la fiche
Else
iRep = MsgBox("Une fiche de pointage existe déjà pour [" & sNom & "] : " & vbCrLf & vbCrLf & sFichierFinal & vbCrLf & vbCrLf & _
"Voulez-vous le remplacer ?", vbOKCancel + vbExclamation) 'boite de dialogue fiche existante voulez vous remplacer
End If
If iRep <> vbOK Then
Exit Sub
End If
Set moFSO = New FileSystemObject
'copie du modèle
[COLOR=rgb(184, 49, 47)][B]moFSO.CopyFile sModele, sFichierFinal, True[/B][/COLOR]
'ouverture fichier final
Set oWBFinal = Workbooks.Open(sFichierFinal)
Set oShFinal = oWBFinal.Worksheets(1)
'alimentation du fichier final
'MsgBox "Alimentation !"
' oShFinal.Range("A2").Value = oShSource.Range("A" & piLig).Value
' oShFinal.Range("C2").Value = oShSource.Range("B" & piLig).Value
' oShFinal.Range("F2").Value = oShSource.Range("C" & piLig).Value
' oShFinal.Range("G2").Value = oShSource.Range("D" & piLig).Value
' oShFinal.Range("H2").Value = oShSource.Range("E" & piLig).Value
' oShFinal.Range("D4").Value = oShSource.Range("F" & piLig).Value
' oShFinal.Range("B2").Value = oShSource.Range("G" & piLig).Value
'save + fermeture
oWBFinal.Save
oWBFinal.Close
Set oShFinal = Nothing
Set oWBFinal = Nothing
Set moFSO = Nothing
Set oShSource = Nothing
MsgBox "La fiche est disponible !" & vbCrLf & vbCrLf & sFichierFinal, vbInformation, "Fiche disponible !"
End Sub
merci du temps que vous m'accorderez