Re : Erreur de compilation dans le module caché : Fonctions
Je me rends compte que c'est plus facile avec le fichier. Je ne peux toutefois pas le transmettre, travaillant dans un secteur plutôt sensible. Cependant, un seul bouton dysfonctionne, il lance le code suivant :
Sub Générateur_fiches()
Application.ScreenUpdating = False
Dim NUMDOSSIER As String
Application.DisplayAlerts = False 'bloque les demandes de choix pour l'utilisateur type Suppression d'une feuille Oui/non
Sheets("Fiche_contrepartie").Select
Call Unprotect
NUMDOSSIER = Range("F1").Value 'correspond à la sélection de l'utilisateur en case F1
DERNIEREFEUILLE = Sheets.Count 'calcule quelle est la dernière feuille
Sheets("Fiche_contrepartie").Copy After:=Sheets(DERNIEREFEUILLE) 'copie après la dernière feuille
If Not FeuilleExiste(NUMDOSSIER) Is Nothing Then Sheets(NUMDOSSIER).Delete 'test pour savoir si la feuille existe déjà, ramène à la fonction ci-dessus, et détruit la feuille le cas échéant
Sheets("Fiche_contrepartie (2)").Select 'sélectionne la feuille créée
If NUMDOSSIER <> "" Then Sheets("Fiche_contrepartie (2)").Name = NUMDOSSIER
If NUMDOSSIER = "" Then
MsgBox "Vous n'avez pas sélectionné de dossier dans le menu déroulant en haut à droite... Non mais franchement... Où aviez-vous la tête, c'est le travail toute cette pression ? Allez ! On arrête de s'endormir et on se reconcentre !
", vbExclamation
Sheets("Fiche_contrepartie (2)").Delete
Sheets("Fiche_contrepartie").Select
Call Protect
Exit Sub
End If 'appelle la feuille tel que défini par l'utilisateur
Dim Bouton As Variant
For Each Bouton In ActiveSheet.Shapes
Bouton.Delete
Next Bouton
Sheets("Fiche_contrepartie").Select
ActiveSheet.Shapes.Range(Array("Picture 2", "Picture 1", "Picture 3")). _
Select
Selection.Copy
Call Protect
Sheets(NUMDOSSIER).Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Cells.Select
Range("A1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1:F1").Select
Selection.Delete Shift:=xlToLeft
Range("D1:F1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Merge
Range("D1:F1").Select
ActiveCell.FormulaR1C1 = _
"Note : fiche au format ""final"", vous pouvez, si vous le souhaitez l'imprimer, la modifier et/ou l'enregistrer."
Range("D1:F1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
La fonction Feuilleexiste a le code suivant :
Function FeuilleExiste(f As String) As Worksheet
On Error Resume Next
Set FeuilleExiste = Worksheets(f)
End Function
Tout le reste fonctionne.
Est-ce que ces informations vous suffisent ?