Sauvegarde sous condition

Le 13/06/2018 à 19:31

Bonjour le forum,

se code me permet de sauvegarder la feuille Result Avec Cellules renseignées je voudrais bloquer la sauvegarde si les cells (4,10 et 4,11) n'est pas renseignée et que la cellules K4 soit colorie,

(4, 11 = K4 )

(4,10 = J4 )

Sub ImpGroupes()

' Macro export en PDF avec nom variable selon contenu cellule.
MsgBox ThisWorkbook.Path & "\" & Sheets("Result").Cells(4, 10).Value & " " & Sheets("Result").Cells(4, 11).Value

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Sheets("Result").Cells(4, 10).Value & " " & Sheets("Result").Cells(4, 11).Value, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False

    ActiveWindow.SelectedSheets.PrintPreview

    Range("K1").Select
End Sub

merci d'avance jean claude

Le 13/06/2018 à 19:50

Bonsoir Ferdinand, bonsoir le forum,

Peut-être comme ça :

Sub ImpGroupes()
Dim O As Worksheet

Set O = Worksheets("Result")
If O.Cells(4, 10).Value = "" Or O.Cells(4, 11).Value = "" Then Exit Sub
If O.Cells(4, 11).Interior.ColorIndex <> xlNone Then Exit Sub

' Macro export en PDF avec nom variable selon contenu cellule.
MsgBox ThisWorkbook.Path & "\" & Sheets("Result").Cells(4, 10).Value & " " & Sheets("Result").Cells(4, 11).Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   ThisWorkbook.Path & "\" & Sheets("Result").Cells(4, 10).Value & " " & Sheets("Result").Cells(4, 11).Value, Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
   False
ActiveWindow.SelectedSheets.PrintPreview
Range("K1").Select
End Sub
Le 13/06/2018 à 21:06

bonsoir ThauThème et le forum

merci de ta réponse,

Set O = Worksheets("Result")
If O.Cells(4, 10).Value = "" Or O.Cells(4, 11).Value = "" Then Exit Sub
If O.Cells(4, 11).Interior.ColorIndex <> xlNone Then Exit Sub

mais cela ne fonctionne pas (pas de mesg d'erreur)

a+ jean claude

Le 13/06/2018 à 22:17

Bonsoir ThauThème et le forum

Après mainte essai et recherche ce code fonctionne

Sub ImpGroupes()

If Range("K4") = "" Then
        MsgBox "Renseigner le groupe en K4 avant de sauvegarder Merci !", vbExclamation
         Range("K4").Interior.ColorIndex = 3
        Exit Sub

    End If

' Macro export en PDF avec nom variable selon contenu cellule.
MsgBox ThisWorkbook.Path & "\" & Sheets("Result").Cells(3, 11).Value & " " & Sheets("Result").Cells(4, 11).Value

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Sheets("Result").Cells(3, 11).Value & " " & Sheets("Result").Cells(4, 11).Value, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False

    ActiveWindow.SelectedSheets.PrintPreview

    Range("K4").Interior.ColorIndex = 2 'couleur intérieure

    Range("K4").Clear 'effacer cellule

    With Range("K4").Borders 'couleur cellule
    .Weight = xlMedium
    Range("K4").Borders(xlInsideVertical).LineStyle = xlNone
    Range("K4").Borders(xlInsideHorizontal).LineStyle = xlNone
End With

    Range("K4").Select 'formatage cellule
    Selection.Font.Size = 9
    Selection.Font.Size = 10
    Selection.Font.Size = 11
    Selection.Font.Bold = True
    Range("K4").Select
End Sub

Si le code peut être à améliorer je suis preneur merci,

***oui il reste à contrôler que le fichier existe déjà

bonne soirée à tous jean claude

Le 13/06/2018 à 23:15

Bonsoir,

Un test.

Sub ImpGroupes()
Dim c As Integer
Dim i As Integer
Dim Fichier As String
i = 0
Fichier = ThisWorkbook.Path & "\" & Cells(3, 11).Value & " " & Cells(4, 11).Value & ".pdf"
For c = 10 To 11
    If Cells(4, c).Value = "" Then
        Cells(4, c).Interior.ColorIndex = 3
        i = 1
    End If
    Next c
    If i = 1 Then
        MsgBox ("Renseigner la cellule surlignée en rouge Merci !"), vbExclamation
        Exit Sub
    End If
    If Dir(Fichier) <> "" Then
        MsgBox ("Enregistrement déjà réalisé avec ces valeurs en J4 et K4, annulation de l'enregistrement")
        Else: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                Exit Sub
            End If
        With Range("J4:K4")
            .ClearContents
        End With
End Sub

Pourquoi as-tu tant de mise en forme en fin de code ?

Cordialement,

Le 14/06/2018 à 19:28

Bonjour Ergotamine et le forum,

merci de ta réponse cela fonctionne,

j'ai fait quelques modif pour effacer la case K4

je passerais le code demain des que je l'aurais finalisé pour ma présentation et le déroulé,

a+ jean claude

Pourquoi as-tu tant de mise en forme en fin de code ?

car je l'ai pris comme je le pensé pas très doué le papy,

Le 14/06/2018 à 21:14

Bonsoir,

Pas de soucis on a tous commencé par là a copier un code trouvé à droite à gauche.

N'hésites pas si tu as encore besoin.

Cordialement,

Le 16/06/2018 à 18:29

Bonjour Ergotamine et le forum,

Merci Ergotamine cela fonctionne,

je voudrais rajouter une fonction je m'entant que la feuille que j'enregistre aille dans

D:\FFME\FFME_2019\HIVERNALE_2019\FichesGroupes le chemin ce trouve dans la feuille ( Parametres en BC25) que je modifie chaque année,

Le code que tu ma joint,

  
Sub ImpGroupes() ' Sauvegarde en PDF et impression feuille GROUPE en PDF
Dim c As Integer
Dim i As Integer
Dim Fichier As String
Dim Dossier As String

'Dossier = Sheets("Parametres").Range("BC25")  '= D:\FFME\FFME_2019\HIVERNALE_2019\FichesGroupes

i = 0
Fichier = ThisWorkbook.Path & "\" & Cells(6, 9).Value & " " & Cells(7, 9).Value & ".pdf"
For c = 9 To 9
    If Cells(7, c).Value = "" Then
        Cells(7, c).Interior.ColorIndex = 3 'Colorie la cellule I7
        i = 1
    End If
    Next c
    If i = 1 Then
        MsgBox ("Renseigner la cellule surlignée en rouge Merci !"), vbExclamation
        Exit Sub
    End If
    If Dir(Fichier) <> "" Then
        MsgBox ("Enregistrement déjà réalisé avec cette valeur en I7.!!!," & vbCrLf & "" & vbCrLf & "Annulation de l'enregistrement," & vbCrLf & "" & vbCrLf & "Priére de saisir le bon N° du groupe ou la catégorie .!!!,")

        With Range("I7")
            .ClearContents 'Efface la cellule I7 après verification du fichier
        End With
        Else: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
                'ActiveWindow.SelectedSheets.PrintPreview ' pour l'instant en Vue

                With Range("I7")
                 .ClearContents 'Efface la cellule K4 après enregistrement
                End With
                Exit Sub

                End If

End Sub

Merci à vous tous et bonne soirée

jean claude

Le 16/06/2018 à 19:08

Bonsoir,

Comme ça ?

Sub ImpGroupes() ' Sauvegarde en PDF et impression feuille GROUPE en PDF
Dim c As Integer
Dim i As Integer
Dim Fichier As String
Dim Dossier As String
Dossier = Sheets("Parametres").Range("BC25").Value
i = 0
Fichier = Dossier & "\" & Cells(6, 9).Value & " " & Cells(7, 9).Value & ".pdf"
For c = 9 To 9
    If Cells(7, c).Value = "" Then
        Cells(7, c).Interior.ColorIndex = 3 'Colorie la cellule I7
        i = 1
    End If
    Next c
    If i = 1 Then
        MsgBox ("Renseigner la cellule surlignée en rouge Merci !"), vbExclamation
        Exit Sub
    End If
    If Dir(Fichier) <> "" Then
        MsgBox ("Enregistrement déjà réalisé avec cette valeur en I7.!!!," & vbCrLf & "" & vbCrLf & "Annulation de l'enregistrement," & vbCrLf & "" & vbCrLf & "Priére de saisir le bon N° du groupe ou la catégorie .!!!,")

        With Range("I7")
            .ClearContents 'Efface la cellule I7 après verification du fichier
        End With
        Else: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
                'ActiveWindow.SelectedSheets.PrintPreview ' pour l'instant en Vue

                With Range("I7")
                 .ClearContents 'Efface la cellule K4 après enregistrement
                End With
                Exit Sub

                End If

End Sub
Le 16/06/2018 à 19:19

Re Ergotamine

je te re merci cela fonctionne,

bonne soirée Jean claude

Rechercher des sujets similaires à "sauvegarde condition"