Bonsoir;
Je voudrais créer une feuille de calcul des prestations pour ma PME. A la base j'attribue 28 points aux clients pour un contrat. au fur et à mesure que j'effectue des prestations, je les reporte dans la feuille de calcul, ainsi que le temps de la prestation. Plus je rempli les heures de prestations les points se décomptes jusqu'à renouvellement de contrat.
La base de points est de 28 qui correspond à 7h de prestation.
Mon souci est de pouvoir creer une formule qui décompte les points comme vous le voyer dans le fichier joint de sorte que (1) affiche le décompte en vert s'il y a encore des points et vire au rouge quand on arrive à zéro.
D'autre part, je voudrais que lors du décompte les zones sans prestations (2) n'affichent pas les chiffres.
Merci d'avance pour votre aide.
J'ai rajouté un bouton "sauvegarde de fichier" qui me permet de faire un enregistrement sous en format PDF et XLS vers un dossier spécifique. Cela fonctionne bien.
Cependant, je voudrais qu'en appuyant sur le bouton une message box s'affiche en me proposant 'introduire le nom de fichier que je pourrais alors taper et par la suite l'enregistrement se fera avec le nom indiqué. Comment dois-je m'y prendre?
J'ai rajouté un bouton "sauvegarde de fichier" qui me permet de faire un enregistrement sous en format PDF et XLS vers un dossier spécifique. Cela fonctionne bien.
Cependant, je voudrais qu'en appuyant sur le bouton une message box s'affiche en me proposant 'introduire le nom de fichier que je pourrais alors taper et par la suite l'enregistrement se fera avec le nom indiqué. Comment dois-je m'y prendre?
Ta demande n'est plus en lien avec le sujet initial,
tu devrais créer un autre topic.
Toutefois, pour te faire avancer tu peux insérer le code ci-dessous dans un module ou même dans le code de la feuille où tu as créé ton bouton,
VB:
Option Explicit
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pSavefilename As SAVEFILENAME) As Long
Private Type SAVEFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Sub Export_Pdf()
Dim OFName As SAVEFILENAME
Dim GSF As Variant
Dim Fname As String
With OFName
.lStructSize = Len(OFName)
.lpstrFile = Space$(254) ' clear nom du fichier
.nMaxFile = 255 ' longueur max du nom de fichier
.lpstrFilter = "Pdf Files" & Chr(0) & "*.pdf" 'Filtre des fichiers désirés
.lpstrTitle = "Exportation de la feuille" ' Titre
.lpstrInitialDir = ThisWorkbook.Path ' Initial directory
.flags = 0 'No flags
Do
GSF = GetSaveFileName(OFName) 'Affiche Open File dialog
If GSF Then
Fname = Split(.lpstrFile, vbNullChar)(0)
If Not Fname Like "*.pdf" Then Fname = Fname & ".pdf"
If Not Dir(Fname) = vbNullString Then
If MsgBox("Le fichier " & Fname & " existe déjà" & vbLf & _
"Voulez-vous l'écraser", vbCritical + vbYesNo) = vbNo Then GSF = -1
End If
If GSF = 1 Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox ActiveSheet.Name & vbLf & " a été sauvegardé dans " & vbLf & Fname
End If
Else
MsgBox "Exportation abandonnée"
End If
Loop While GSF < 0
End With
End Sub
Affectes par la suite la macro Export_PDF à ton bouton.
Nota; le code fonctionne avec une version 32bits d'Excel (le plus courant), si tu utilises la version 64bits, y'aura qq modifications à faire .
Ta demande n'est plus en lien avec le sujet initial,
tu devrais créer un autre topic.
Toutefois, pour te faire avancer tu peux insérer le code ci-dessous dans un module ou même dans le code de la feuille où tu as créé ton bouton,
VB:
Option Explicit
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pSavefilename As SAVEFILENAME) As Long
Private Type SAVEFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Sub Export_Pdf()
Dim OFName As SAVEFILENAME
Dim GSF As Variant
Dim Fname As String
With OFName
.lStructSize = Len(OFName)
.lpstrFile = Space$(254) ' clear nom du fichier
.nMaxFile = 255 ' longueur max du nom de fichier
.lpstrFilter = "Pdf Files" & Chr(0) & "*.pdf" 'Filtre des fichiers désirés
.lpstrTitle = "Exportation de la feuille" ' Titre
.lpstrInitialDir = ThisWorkbook.Path ' Initial directory
.flags = 0 'No flags
Do
GSF = GetSaveFileName(OFName) 'Affiche Open File dialog
If GSF Then
Fname = Split(.lpstrFile, vbNullChar)(0)
If Not Fname Like "*.pdf" Then Fname = Fname & ".pdf"
If Not Dir(Fname) = vbNullString Then
If MsgBox("Le fichier " & Fname & " existe déjà" & vbLf & _
"Voulez-vous l'écraser", vbCritical + vbYesNo) = vbNo Then GSF = -1
End If
If GSF = 1 Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox ActiveSheet.Name & vbLf & " a été sauvegardé dans " & vbLf & Fname
End If
Else
MsgBox "Exportation abandonnée"
End If
Loop While GSF < 0
End With
End Sub
Affectes par la suite la macro Export_PDF à ton bouton.
Nota; le code fonctionne avec une version 32bits d'Excel (le plus courant), si tu utilises la version 64bits, y'aura qq modifications à faire .
Le code ci-dessous devrait fonctionner en 32 et 64bits :
VB:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pSavefilename As SAVEFILENAME) As Long
#Else
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pSavefilename As SAVEFILENAME) As Long
#End If
Private Type SAVEFILENAME
lStructSize As Long
#If VBA7 Then
hwndOwner As LongPtr
hInstance As LongPtr
#Else
hwndOwner As Long
hInstance As Long
#End If
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
#If VBA7 Then
lCustData As LongPtr
lpfnHook As LongPtr
#Else
lCustData As Long
lpfnHook As Long
#End If
lpTemplateName As String
End Type
Sub Export_Pdf()
Dim OFName As SAVEFILENAME
Dim GSF As Variant
Dim Fname As String
With OFName
.lStructSize = Len(OFName)
.lpstrFile = Space$(254) ' clear nom du fichier
.nMaxFile = 255 ' longueur max du nom de fichier
.lpstrFilter = "Pdf Files" & Chr(0) & "*.pdf" 'Filtre des fichiers désirés
.lpstrTitle = "Exportation de la feuille" ' Titre
.lpstrInitialDir = ThisWorkbook.Path ' Initial directory
.flags = 0 'No flags
Do
GSF = GetSaveFileName(OFName) 'Affiche Open File dialog
If GSF Then
Fname = Split(.lpstrFile, vbNullChar)(0)
If Not Fname Like "*.pdf" Then Fname = Fname & ".pdf"
If Not Dir(Fname) = vbNullString Then
If MsgBox("Le fichier " & Fname & " existe déjà" & vbLf & _
"Voulez-vous l'écraser", vbCritical + vbYesNo) = vbNo Then GSF = -1
End If
If GSF = 1 Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox ActiveSheet.Name & vbLf & " a été sauvegardé dans " & vbLf & Fname
End If
Else
MsgBox "Exportation abandonnée"
End If
Loop While GSF < 0
End With
End Sub
Le code ci-dessous devrait fonctionner en 32 et 64bits :
VB:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pSavefilename As SAVEFILENAME) As Long
#Else
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pSavefilename As SAVEFILENAME) As Long
#End If
Private Type SAVEFILENAME
lStructSize As Long
#If VBA7 Then
hwndOwner As LongPtr
hInstance As LongPtr
#Else
hwndOwner As Long
hInstance As Long
#End If
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
#If VBA7 Then
lCustData As LongPtr
lpfnHook As LongPtr
#Else
lCustData As Long
lpfnHook As Long
#End If
lpTemplateName As String
End Type
Sub Export_Pdf()
Dim OFName As SAVEFILENAME
Dim GSF As Variant
Dim Fname As String
With OFName
.lStructSize = Len(OFName)
.lpstrFile = Space$(254) ' clear nom du fichier
.nMaxFile = 255 ' longueur max du nom de fichier
.lpstrFilter = "Pdf Files" & Chr(0) & "*.pdf" 'Filtre des fichiers désirés
.lpstrTitle = "Exportation de la feuille" ' Titre
.lpstrInitialDir = ThisWorkbook.Path ' Initial directory
.flags = 0 'No flags
Do
GSF = GetSaveFileName(OFName) 'Affiche Open File dialog
If GSF Then
Fname = Split(.lpstrFile, vbNullChar)(0)
If Not Fname Like "*.pdf" Then Fname = Fname & ".pdf"
If Not Dir(Fname) = vbNullString Then
If MsgBox("Le fichier " & Fname & " existe déjà" & vbLf & _
"Voulez-vous l'écraser", vbCritical + vbYesNo) = vbNo Then GSF = -1
End If
If GSF = 1 Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fname, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox ActiveSheet.Name & vbLf & " a été sauvegardé dans " & vbLf & Fname
End If
Else
MsgBox "Exportation abandonnée"
End If
Loop While GSF < 0
End With
End Sub