Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
'If FeuilleExiste(NomFeuille) Then'GoTo FinCreation'Sheets("fiche").CopySub enrFact()
Dim NomFeuille as String, i As Byte, Ligne As Integer
NomFeuille = Range("C9")
For i = 1 To Sheets.Count
If Sheets(i).Name = NomFeuille Then
Trouve = True
Exit For
End If
Next
If Trouve = True Then
If MsgBox("La feuille " & NomFeuille & " existe déjà!" & vbCrLf & _
"voulez-vous la remplacer?", vbQuestion + vbYesNo, "Suppression Feuille") = vbYes Then
Application.DisplayAlerts = False
Sheets(NomFeuille).Delete
Application.DisplayAlerts = True
Else: Exit Sub
End If
End If
Sheets("facture").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = NomFeuille
With Sheets("facturier entrées")
Ligne = .Range("A65536").End(xlUp).Row + 1
.Hyperlinks.Add Anchor:=.Cells(Ligne, 1), _
Address:="", _
SubAddress:="'" & NomFeuille & "'!A1", _
TextToDisplay:=NomFeuille
.Cells(Ligne, 2) = Sheets("facture").Range("C7")
.Cells(Ligne, 3) = Sheets("facture").Range("G7")
.Cells(Ligne, 4) = Sheets("facture").Range("C8")
.Cells(Ligne, 5).FormulaLocal = "='" & NomFeuille & "'!$J$32"
.Cells(Ligne, 6).FormulaLocal = "='" & NomFeuille & "'!$J$30"
.Cells(Ligne, 7).FormulaLocal = "='" & NomFeuille & "'!$J$28"
.Cells(Ligne, 8).FormulaLocal = "='" & NomFeuille & "'!$J$29"
.Cells(Ligne, 9).FormulaLocal = "='" & NomFeuille & "'!$G$32"
End With
Sheets("facture").Range("F2") = Range("F2") + 1
End Sub'### Constantes à adapter ###
Const MODELE_FACTURE As String = "___ModeleFacture"
Const FACTURE As String = "facture"
'############################
Sub enrFact()
Dim NomFeuille As String
Dim Ligne As Long
Dim FACT As Worksheet
Dim MODELE As Worksheet
Dim S As Worksheet
Dim SH As Shape
On Error Resume Next
Set FACT = Sheets(FACTURE)
If Err <> 0 Then
MsgBox "La feuille ''" & FACTURE & "'' est introuvable."
Exit Sub
End If
'Récupération du nom de la nouvelle feuille
NomFeuille = FACT.Range("C9")
'Teste si elle existe déjà.
Set S = Sheets(NomFeuille)
If Err = 0 Then
If MsgBox("La feuille '" & NomFeuille & "' existe déjà!" & vbCrLf & _
"voulez-vous la remplacer?", vbQuestion + vbYesNo, "Créer") = vbYes Then
'Si oui on la détruit
Application.DisplayAlerts = False
Sheets(NomFeuille).Delete
Application.DisplayAlerts = True
End If
End If
On Error GoTo 0
FACT.Copy After:=Worksheets(Sheets.Count)
Set S = ActiveSheet
S.Name = NomFeuille
'--- Supprime les boutons de la nouvelle feuille ---
For Each SH In S.Shapes
If SH.Type = msoFormControl Then SH.Delete
Next SH
'--- Supprime les formules de la nouvelle feuille ---
S.Cells.Copy
S.Cells.PasteSpecial Paste:=xlPasteValues
S.[a1].Select
Application.CutCopyMode = False
'-------------
With Sheets("facturier entrées")
Ligne = .Range("A65536").End(xlUp).Row + 1
.Hyperlinks.Add Anchor:=.Cells(Ligne, 1), _
Address:="", _
SubAddress:="'" & NomFeuille & "'!A1", _
TextToDisplay:=NomFeuille
.Cells(Ligne, 2) = S.Range("C7")
.Cells(Ligne, 3) = S.Range("G7")
.Cells(Ligne, 4) = S.Range("C8")
.Cells(Ligne, 5) = S.Range("J32")
.Cells(Ligne, 6) = S.Range("J30")
.Cells(Ligne, 7) = S.Range("J28")
.Cells(Ligne, 8) = S.Range("J29")
.Cells(Ligne, 9) = S.Range("G32")
End With
'--- Détruit la feuille "facture" et la reconstruit à partir d'un modèle ---
On Error Resume Next
Set MODELE = Sheets(MODELE_FACTURE)
If Err <> 0 Then
MsgBox "La feuille modèle ''" & MODELE_FACTURE & "'' est introuvable."
Exit Sub
End If
On Error GoTo 0
Application.DisplayAlerts = False
FACT.Delete
Application.DisplayAlerts = True
With MODELE
.Visible = xlSheetVisible
.[f2] = .[f2] + 1
.Copy After:=Sheets(.Index)
ActiveSheet.Name = FACTURE
.Visible = xlSheetHidden
End With
End Sub
