Microsoft 365 démasquage sous conditions lors de l'impression

FCMLE44 · 18 Septembre 2020

Bonjour

Dans le fichier joint, feuille base,
- Si case à cocher est égale à Oui, alors démasquer cellules 159 à 218 de la feuille "Feuille Calcul indemnités" puis imprimer toutes les feuilles dont feuille calcul indemnités
- Si case à cocher est égale à Non, alors laisser masquées les cellules 159 à 218 de la feuille "Feuille Calcul indemnités" puis imprimer toutes les feuilles dont feuille calcul indemnités

Dans le code, je souhaiterais pouvoir renommer les feuilles qui seront à imprimer

Avez vous une idée de comment je pourrais faire svp ?

Merci

fanch55 · 22 Septembre 2020

Salut,
je suppose que quand vous parlez des cellules 159 à 218, vous parlez des lignes ...
A mettre dans le code de la feuille "Base" et à tester :

VB:

Private Sub OptionButton1_Click()
    With Sheets("Feuille Calcul Indemnités")
        .Activate
        .Rows("159:218").EntireRow.Hidden = False
    End With
    Print_Sheets True
    Print_Sheets False
End Sub
Private Sub OptionButton2_Click()
    With Sheets("Feuille Calcul Indemnités")
        .Activate
        .Rows("159:218").EntireRow.Hidden = True
    End With
    Print_Sheets True
    Print_Sheets False
End Sub
Sub Print_Sheets(Optional Tout = False)
    If Tout Then
        Worksheets.PrintPreview
    Else
        List = "Feuil3"
        List = List & "," & "Feuil4"
        List = List & "," & "Feuil5"
        List = List & "," & "Feuille Calcul Indemnités"
        Sheets(Split(List, ",")).PrintPreview
    End If
End Sub

Après les test, remplacer printpreview par printout.
l'option true correspond à votre demande initiale d'imprimer toutes les feuilles
l'option False correspond à votre demande de pouvoir renommer (donc indiquer) les feuilles à imprimer.
Commentez la ligne non choisie ...

FCMLE44 · 25 Septembre 2020

Bonjour
Aujourdhui, en cliquant feuille salariés sur le bouton imprimante en F20 un userform s'ouvre me donnant 3 choix différents (Case0, Case1, et Case2) afin de créer le PDF et l'enregistrer sous certaines conditions

Cela fonctionne bien mais mon souci est que le PDF ainsi crée prend automatiquement le nom de la sélection. Ce que je souhaiterais, c'est que nous puissions le renommer comme on le souhaite et le mettre dans le répertoire que l'on souhaite

VB:

Sub EditionPDF(fselection, TempsPartiel As Boolean)

Dim ws As Worksheet
Dim Dossier$, Nom$, chemin$

'OUVRE BOITE DE DIALOGUE DE SELECTION DOSSIER
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show 'affiche
    If .SelectedItems.Count > 0 Then 'si dossier selectionné
       Dossier = .SelectedItems(1) 'Dossier a pour valeur le répertoire
   Else
      MsgBox "Procédure annulée, aucun dossier sélectionné"
      
      Exit Sub 'sinon, sortie procédure
    
    End If
End With

Nom = Génération.ComboBox1.Value

'EDITION PDF
If TempsPartiel Then 'si temps partiel (issu du choix effectué en amont) vrai
    Sheets("Indemnités").Range("Partiel").EntireRow.Hidden = False 'affiche les lignes de "Indemnités"
End If
chemin = Dossier & "\" & Nom & ".pdf" 'chemin = dossier & "nom de opération sur liste".pdf >>> A AMELIORER (VARIABILISER DATE OU NOMS)
Worksheets(fselection).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, ignoreprintareas:=False 'export pdf
Sheets("Indemnités").Range("Partiel").EntireRow.Hidden = True 'affiche les lignes de "Indemnités"
Sheets("Salariés").Select
Range("A6").Select

MsgBox "Edition des fichiers terminée !"

End If

Dans un 2e temps, je souhaiterais faire les choses suivantes

- avec le choix Case 0, je souhaitais annexer à cette macro, l'envoi du fichier généré en pdf par mail avec le code ci-dessous qui était dans un autre post (module5)

VB:

Option Explicit

Sub ChoixMultiFichiers_EnvoiMail_Simu()
    Dim Fichiers As Variant
    Dim i As Integer
    Dim Ol As Outlook.Application
    Dim olMail As MailItem
    Dim SigString As String
    Dim Signature As String

    'Affiche la boîte dialogue "Ouvrir"
    '(C'est l'argument True qui autorise la multisélection)
    Fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", , , , True)

   Set Ol = New Outlook.Application
   Set olMail = Ol.CreateItem(olMailItem)

'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\travail.htm"

If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = ""
End If

    With olMail
        .To = Range("AA1")
        .CC = Range("AB1")
        .Subject = "Calcul Indemnité de départ " & Range("B9") & " à valider"
        .HTMLBody = "<html><body>Bonjour,</body></html><br>" & _
            "<html><body>Ci-joint la simulation de départ demandée pour validation</body></html><br>" & _
            "<html><body>Est-il possible de la faire parvenir ensuite au service RH de la société concernée ?</body></html><br>" & _
            "<html><body>Bonne réception</body></html><br>" & "<html><body>Cordialement</body></html>" & _
             "<br>" & Signature & .HTMLBody             'le corps du mail ..son contenu

        'Boucle sur le tableau pour récupérer le nom du ou des classeurs sélectionnées.
        '(IsArray(Fichiers) renvoie False si aucun fichier n'a été sélectionné).
        If IsArray(Fichiers) Then
            For i = 1 To UBound(Fichiers)
                .Attachments.Add Fichiers(i)
            Next
        End If

        .Display
    End With
End Sub

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

- avec le choix Case 1 Dossier Complet, je souhaitais faire la même chosemais avec ces conditions que voici :

- si la cellule D18 de la feuille Salariés est = "Licenciement Faute Grave", "Licenciement Autres", "Retraite", "Rupture Conventionnelle" et que la cellule E74 de la feuille Courriers est > à 15 000 alors envoi systématique du mail via code ci-dessous. Dans la négative, le mail ne sera pas envoyé.(module3)

Code:

Option Explicit

Sub ChoixMultiFichiers_EnvoiMail_ValidSTC()
    Dim Fichiers As Variant
    Dim i As Integer
    Dim Ol As Outlook.Application
    Dim olMail As MailItem
    Dim SigString As String
    Dim Signature As String

    'Affiche la boîte dialogue "Ouvrir"
    '(C'est l'argument True qui autorise la multisélection)
    Fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", , , , True)

   Set Ol = New Outlook.Application
   Set olMail = Ol.CreateItem(olMailItem)

'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\travail.htm"

If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = ""
End If

    With olMail
        .To = Range("AA1")
        .CC = Range("AB1")
        .Subject = "Solde de Tout compte " & Range("B9") & " à valider"
        .HTMLBody = "<html><body>Bonjour,</body></html><br>" & _
            "<html><body>Ci-joint dossier Solde de Tout Compte pour validation</body></html><br>" & _
            "<html><body>Est-il possible de m'informer de sa validation pour envoi courrier au salarié ?</body></html><br>" & _
            "<html><body>Bonne réception</body></html><br>" & "<html><body>Cordialement</body></html>" & _
             "<br>" & Signature & .HTMLBody             'le corps du mail ..son contenu

        'Boucle sur le tableau pour récupérer le nom du ou des classeurs sélectionnées.
        '(IsArray(Fichiers) renvoie False si aucun fichier n'a été sélectionné).
        If IsArray(Fichiers) Then
            For i = 1 To UBound(Fichiers)
                .Attachments.Add Fichiers(i)
            Next
        End If

        .Display
    End With
End Sub

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Je pensais utiliser

Code:

Nom = Inputbox("Nom du fichier :")
If Nom = "" then Nom = "Nompardefaut"
'Nom = Nom & ".pdf" à activer le cas échéant

Mis je ne sais à quel endroit du code en module 4, l'insérer

Pour les mails, a quel endroit dans les modules 5 et 3 je pourrais mettre ceci

Code:

Call EnvoiMail(Chemin)

Quelqu'un aurait il une idée ?

Merci

Cordialement

FCMLE44 · 28 Septembre 2020

Bonjour
Personne n'a une idée ?

FCMLE44 · 28 Septembre 2020

C'est bon j'ai réussi pour enregistrer mes pdf dans le répertoire de mon choix
Voici le code définitif pour cette partie

VB:

Sub EditionPDF(fselection, TempsPartiel As Boolean)

Dim ws As Worksheet
Dim Dossier$, Nom$, chemin$

'OUVRE BOITE DE DIALOGUE DE SELECTION DOSSIER
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show 'affiche
    If .SelectedItems.Count > 0 Then 'si dossier selectionné
       Dossier = .SelectedItems(1) 'Dossier a pour valeur le répertoire
   Else
      MsgBox "Procédure annulée, aucun dossier sélectionné"
      
      Exit Sub 'sinon, sortie procédure
    
    End If
End With

Nom = Génération.ComboBox1.Value

'EDITION PDF
If TempsPartiel Then 'si temps partiel (issu du choix effectué en amont) vrai
    Sheets("Indemnités").Range("Partiel").EntireRow.Hidden = False 'affiche les lignes de "Indemnités"
End If
Nom = InputBox("Nom du fichier :")
If Nom = "" Then Nom = "Nompardefaut"
'Nom = Nom & ".pdf" à activer le cas échéant
chemin = Dossier & "\" & Nom & ".pdf" 'chemin = dossier & "nom de opération sur liste".pdf >>> A AMELIORER (VARIABILISER DATE OU NOMS)
Worksheets(fselection).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, ignoreprintareas:=False 'export pdf
Sheets("Indemnités").Range("Partiel").EntireRow.Hidden = True 'affiche les lignes de "Indemnités"
Sheets("salariés").Select
Range("A6").Select

MsgBox "Edition des fichiers terminée !"

End Sub

Reste à savoir maintenant comment je peux rattacher mon code envoi mail selon le règles définies ci-dessus.

Si quelqu'un peut me donner une piste

Merci

FCMLE44 · 28 Septembre 2020

Ok je commence à comprendre
J'ai mis à la fin du code EditionPDF

VB:

Call ChoixMultiFichiers_EnvoiMail_Simu 'nom du code pour envoi par mail

Et ca fonctionne.
Pour les conditions, il faut que j'utilise les fonctions IF Then c'est cà ?

FCMLE44 · 28 Septembre 2020

Si je mets çà

VB:

If Range("D18") = "Licenciement Faute Grave" Or Range("D18") = "Licenciement Autres" Or Range("D18") = "Retraite" Or Range("D18") = "Rupture Conventionnelle" Or Sheets("Courriers").Range("E74") >= 15000 Then
Call ChoixMultiFichiers_EnvoiMail_Simu

Ca ne marche pas. De plus, cette règle ne vaut que si Case 1 sélectionnée

FCMLE44 · 28 Septembre 2020

C bon c''est ok
Merci

Effectuez une recherche sur Excel Downloads...

Microsoft 365 démasquage sous conditions lors de l'impression

FCMLE44

XLDnaute Impliqué

Pièces jointes

fanch55

fanch55

XLDnaute Barbatruc

FCMLE44

XLDnaute Impliqué

Pièces jointes

FCMLE44

XLDnaute Impliqué

FCMLE44

XLDnaute Impliqué

FCMLE44

XLDnaute Impliqué

FCMLE44

XLDnaute Impliqué

FCMLE44

XLDnaute Impliqué

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums