Bonjour Sylvanu
J'ai essayer ton fichier et c'est bien cela , mais quand je modifie mon fichier avec tes info ,cela bloc à cheminfacture = [Chemin] et je ne vois pas pourquoi. Voici le VBA ci-dessous
est-il possible de mettre dans la cellule que l'année
Sub options(cellule)
coladhe = 5
Set adhe = cellule.Parent.Cells(cellule.Row, coladhe)
n = 0
Set dest = Sheets("facture").Range("c32")
x = 0
'type de lignes
lignes = Array("Cotisation", "License", "Location")
'tant que c'est le même adhérent
While adhe.Offset(n, 0) = adhe
'pour chaque type de ligne
For l = 0 To UBound(lignes)
If adhe.Offset(n, 8 + l) <> "" Then
'valeur
dest.Offset(x, 1) = adhe.Offset(n, 8 + l)
'type de ligne et activité
dest.Offset(x, 0) = lignes(l) & " " & adhe.Offset(n, 6)
x = x + 1
End If
Next
n = n + 1
Wend
Sheets("facture").Range("I15").Value = ThisWorkbook.Names("numfact").RefersToRange + 1
End Sub
Sub remplir(cellule)
ligne = cellule.Row
Set debcol = Sheets("para").Range("a5")
Set Source = Sheets("Inscription")
Set dest = Sheets("Facture")
n = 0
While debcol.Offset(n, 0) <> ""
dest.Range(debcol.Offset(n, 1)) = Source.Cells(ligne, debcol.Offset(n, 0))
n = n + 1
'Date du jour
dest.Range("G3") = WorksheetFunction.Proper(Format(Date, "dddd d mmmm yyyy"))
'N°de la facture
dest.Range("K15") = Month(Date)
dest.Range("M15") = Year(Date)
Worksheets("Facture").Range("c31").Value = Worksheets("Inscription").Range("l3").Value
Wend
Call options(cellule)
End Sub
'Enregistrement de la facture
Sub enregistrement()
Dim cheminfacture As String
cheminfacture = [Chemin]
If Right(cheminfacture, 1) <> "\" Then cheminfacture = cheminfacture & "\"
numerodefacture 'Calcul du numéro de facture
With Sheets("facture")
nomfichier = "facture" & "_" & ThisWorkbook.Names("numfact").RefersToRange & "_" & .Range("i21") & " " & .Range("g21")
Chemin = cheminfacture & nomfichier
ThisWorkbook.Sheets("Inscription").Activate
'Si le fichier existe alors question Cette partie n'est pas sensé être possible sauf si le numéro de facture de la feuille para est modifié à la main
Set fso = CreateObject("Scripting.FileSystemObject")
fexist = fso.fileexists(Chemin & ".pdf")
If fexist = True Then
Réponse1 = MsgBox("Un facture a déjà été enregistrer sous ce nom. Souhaitez-vous le remplacer?", vbYesNo)
If Réponse1 = 7 Then
ThisWorkbook.Names("numfact").RefersToRange = ThisWorkbook.Names("numfact").RefersToRange - 1
Exit Sub
End If
End If
'------------------------------------------
'.Range("A1:M45").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
.UsedRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Faire CTRL/Shift/FlècheBas ou droite/Gomme/Clic autre cellule/Enregistré/Fermer
End With
MsgBox "Le fichier " & nomfichier & " s'est enregistrer dans le répertoire Facture."
ThisWorkbook.Sheets("Inscription").Activate
End Sub
Sub numerodefacture()
'Incrémente le numéro de facture, et implémente le chrono
ThisWorkbook.Names("numfact").RefersToRange = ThisWorkbook.Names("numfact").RefersToRange + 1
dLig = Sheets("Chrono").Cells(Rows.Count, "B").End(xlUp).Row + 1
With Sheets("chrono")
.Cells(dLig, 1) = ThisWorkbook.Names("numfact").RefersToRange
.Cells(dLig, 2) = Sheets("facture").Range("G7").Value
.Cells(dLig, 3) = Sheets("facture").Range("i21").Value
.Cells(dLig, 4) = Sheets("facture").Range("g21").Value
End With
End Sub
' effacement des données de la feuille facture
Sub efface1()
Set debcol = Sheets("para").Range("b5")
Set dest = Sheets("Facture")
n = 0
While debcol.Offset(n, 0) <> ""
dest.Range(debcol.Offset(n, 0)) = ""
n = n + 1
Wend
End Sub
Merci encore de ton aide
Bambi35