XL 2019 Creer une feuille de prestation décroissante.

M

master1306

XLDnaute Nouveau
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.
 

Pièces jointes

  • decompte contrat de maintenance.xlsx
    10.3 KB · Affichages: 11
  • 2019-11-23_203910.jpg
    2019-11-23_203910.jpg
    159 KB · Affichages: 16
Trier par date Trier par votes
M

master1306

XLDnaute Nouveau
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?
 

Pièces jointes

  • UTILE.xlsx
    36.4 KB · Affichages: 0
Vote positif 0 Vote négatif
M

master1306

XLDnaute Nouveau
JHA à dit:
Bonjour à tous,

Juste un petit soucis de dimension du tableau
Avant: =$B$14:$E$36
Maintenant: =$B$14:$E$35

JHA
Cliquez pour agrandir...
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?
 

Pièces jointes

  • UTILE.xlsx
    36.4 KB · Affichages: 4
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Bonsoir Master1306,

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 .
 
Vote positif 0 Vote négatif
M

master1306

XLDnaute Nouveau
fanch55 à dit:
Bonsoir Master1306,

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 .
Cliquez pour agrandir...
Merci pour ton aide fanch55. Malhereusement, je viens de me rendre compte que j'utilise excel 64bits. Quelles modifications faut il faire?
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
M

master1306

XLDnaute Nouveau
fanch55 à dit:
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
Cliquez pour agrandir...
mERCI ENCORE . ça marche impec.
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 Problème de classement de prix croissants non désiré
Réponses
4
Affichages
390
chris
chris
M
  • Résolu(e)
XL 2016 UseForm VBA pour renseigner automatiquement des colonnes sur une autre feuille
Réponses
11
Affichages
515
Moussa040810
M
Oskafo
  • Question
Microsoft 365 Colonne avec une formule d'une feuille 1 qui se répercute sur une feuille 2 ?
Réponses
10
Affichages
698
Oskafo
Oskafo
N
  • Résolu(e)
XL 2021 copier ligne vers une feuille existante sous condition et supprimer ligne de la feuille d'origine
Réponses
9
Affichages
426
NicolasKH
N
S
  • Résolu(e)
XL 2016 Comment classer des résultats avec attributs et couleurs et avoir la somme des classes sur une feuille Excel?
Réponses
6
Affichages
381
stuka
S
N
  • Résolu(e)
XL 2019 Automatiser la répartition des effectifs dans une feuille de calcul
Réponses
4
Affichages
344
Nasseuz
N
V
  • Question
Microsoft 365 copie de couleur d'une cellule à une autre sous condition
2 3
Réponses
35
Affichages
2 K
virdg
V
6
  • Résolu(e)
XL 2019 Copier-coller tableau dans une feuille de calcul via VBA
Réponses
11
Affichages
778
job75
job75
M
  • Question
XL 2016 Facturation avec points
Réponses
5
Affichages
519
xUpsilon
xUpsilon
L
  • Question
Microsoft 365 Copier les mêmes lignes venant de différentes feuilles dans une feuille "Summary"
Réponses
3
Affichages
483
liod21
L

Membres actuellement en ligne

11 membres et 89 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 203
Messages
2 086 193
Membres
103 153
dernier inscrit
SamirN