Erreur version Excel
l
Bonjour,
Le code suivant me renvoi une erreur de version sur Excel 2013, une idée svp ??
Sub Imprimer()
Dim NumeroDemande As String
Dim fso As FileSystemObject
Dim Chemin As String
'Déverrouille les cellules
ActiveSheet.Unprotect ("1105")
'Active l'impression
Application.EnableEvents = False
' Mets a jour la participation
Call RAFParticipation
ActiveSheet.Unprotect ("1105")
' FiltrerZero Macro
ActiveSheet.Range("$A$26:$F$245").AutoFilter Field:=4, Criteria1:="<>0", Operator:=xlFilterValues
' Vérifie la présence d'un numéro de demande
If Range("I5").Value = "" Then
'Demande d'entrer un numéro de demande
NumeroDemande = InputBox("Le numéro de la demande n'a pas été renseigné !" & vbCrLf & vbCrLf & _
"Demande numéro :", "DEVIS DEMANDE EN EAU")
If NumeroDemande = "" Then
Exit Sub
End If
Range("I5").Value = NumeroDemande
Chemin = "\\Oc-rh\Users\Marché à Bon de Commande\1- ESTIMATIONS\Secteurs\"
Set fso = New FileSystemObject
If Not fso.FolderExists(Chemin) Then
'choix du chemin d'enregistrement
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Sélectionnez le répertoire"
.Show
On Error GoTo fin
repertoire = .SelectedItems(1)
End With
ActiveWorkbook.SaveAs Filename:=repertoire & "\" & Format(Date, "yyyymm") & "-" & Range("I5").Value
' Ouvre l'aperçue avant impression
ActiveSheet.PrintPreview
Else
On Error GoTo fin
' Enregistre le devis sur server
ActiveWorkbook.SaveAs Filename:="\\Oc-rh\Users\Marché à Bon de Commande\1- ESTIMATIONS\Secteurs\" & Range("I3") & "\" & Format(Date, "yyyymm") & "-" & Range("I5").Value
' Ouvre l'aperçue avant impression
ActiveSheet.PrintPreview
End If
Else
Chemin = "\\Oc-rh\Users\Marché à Bon de Commande\1- ESTIMATIONS\Secteurs\"
Set fso = New FileSystemObject
If Not fso.FolderExists(Chemin) Then
'choix du chemin d'enregistrement
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Sélectionnez le répertoire"
.Show
On Error GoTo fin
repertoire = .SelectedItems(1)
End With
ActiveWorkbook.SaveAs Filename:=repertoire & "\" & Format(Date, "yyyymm") & "-" & Range("I5").Value
' Ouvre l'aperçue avant impression
ActiveSheet.PrintPreview
Else
On Error GoTo fin
' Enregistre le devis sur server
ActiveWorkbook.SaveAs Filename:="\\Oc-rh\Users\Marché à Bon de Commande\1- ESTIMATIONS\Secteurs\" & Range("I3") & "\" & Format(Date, "yyyymm") & "-" & Range("I5").Value
' Ouvre l'aperçue avant impression
ActiveSheet.PrintPreview
End If
End If
'Désactive l'impression
Application.EnableEvents = True
'Verrouille les cellules
ActiveSheet.Protect ("1105")
Exit Sub
fin:
MsgBox ("Avant toute impression, merci de bien vouloir sauvegarder votre devis.")
'Désactive l'impression
Application.EnableEvents = True
'Verrouille les cellules
ActiveSheet.Protect ("1105")
End SubBonsoir,
quel est l'erreur ? L'intitulé ?
En plus il y a un "Call" sans le code qui va avec...
Un fichier peut-être ?
@ bientôt
LouReeD
Invité
Bonjour à tous,
Essaye les modif suivantes :
* au début :
Sub Imprimer()
Dim NumeroDemande As String
Dim fso As Object
Dim Chemin As String, repertoire As String
Set fso = CreateObject("Scripting.FileSystemObject")
...* ensuite supprimer les lignes :
Set fso = New FileSystemObjectPierre
l
Bonsoir,
quel est l'erreur ? L'intitulé ?
En plus il y a un "Call" sans le code qui va avec...
Un fichier peut-être ?
@ bientôt
LouReeD
Le message d'erreur me dis :
Erreur de compilation dans le module caché : Module1
Cette erreur se produit généralement lorsque le code est incompatible avec la version, plateforme ou architecture de cette application.
Dans le call RAFParticipation le code est basic rien qui peu poser problème à mon avis mais voici le Code :
Sub RAFParticipation()
'Déverrouille les cellules
ActiveSheet.Unprotect ("1105")
If Range("i4").Value = "" Or Range("i9").Value = "" Or Range("z5").Value = "" Or Range("u9").Value = "" Then
MsgBox "Trop de données sont manquantes pour évaluer la participation client."
Else
'Selection de la participation a appliquer
Type_Branchement = Range("i4").Value
Select Case Type_Branchement
Case Is = "Branchement particulier"
Client = Range("I9").Value
CT = Round(Range("Z5").Value, 2) / Client
If CT <= 1500 Then
CP = 607.26
Range("U9").Value = Round(CP, 2)
ElseIf CT > 1500 And CT <= 3000 Then
CP = 607.26 + ((CT - 1500) * 0.5)
Range("U9").Value = Round(CP, 2)
Else
CP = (607.26 + 750 + (CT - 3000))
Range("U9").Value = Round(CP, 2)
End If
Case Is = "Branchement Agricole"
If Range("M4").Value = "" Then
MsgBox "Merci de renseigner la qualité de l'exploitant."
Else
Client = Range("I9").Value
CT = Round(Range("Z5").Value, 2) / Client
Qualite = Range("M4").Value
Select Case Qualite
Case Is = "Titre principal"
If CT <= 8000 Then
CP = 253.03
Range("U9").Value = Round(CP, 2)
Else
CP = 253.03 + (CT - 8000)
Range("U9").Value = Round(CP, 2)
End If
Case Is = "Titre secondaire", "Retraité, Cotisant solidaire"
If CT <= 8000 Then
CP = CT * 0.3
Range("U9").Value = Round(CP, 2)
Else
CP = ((CT - 8000) * 0.3) + (CT - 8000)
Range("U9").Value = Round(CP, 2)
End If
Case Is = "Jeune Agriculteur (JA)"
CP = 0
Range("U9").Value = Round(CP, 2)
End Select
End If
Case Is = "Branchement Industriel", "Autres"
If Range("I47").Value = "" Then
MsgBox "Merci de renseigner la marge a appliquer."
Else
Marge = Range("I47").Value / 100
Client = Range("I9").Value
CT = Round(Range("Z5").Value, 2) / Client
CP = (CT * Marge) + CT
Range("U9").Value = Round(CP, 2)
End If
End Select
End If
'Verrouille les cellules
ActiveSheet.Protect ("1105")
End Submerci de ton aide
Bonjour,
Tu ne travailles pas sous Mac ?
Cdlt.
l
l