XL 2021 code vba pour autorisez l'enregistrement par le bouton "enregistrer" uniquement si tout les champs sont remplis

phoceenjo

XLDnaute Nouveau
Bonjour à tous,

Je débute avec les codes VBA et j'aurais besoin de votre aide.

Je souhaiterais que sur le fichier joint, je ne puisse sauvegarder en cliquant sur le bouton enregistrer uniquement si tous les champs pouvant être remplie soit avec une liste déroulante soit manuellement le soit réellement.

Pouvez vous m'aider s'il vous plait ?

je vous remercie d'avance
 

Pièces jointes

  • Fichier test.xlsm
    300.3 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour phoceenjo, et bienvenu sur XLD,
Peut être simplement en commençant la macro Enregistrer par :
VB:
If [G6] = "" Or [I6] = "" Or [G9] = "" Or [I9] = "" Then
    MsgBox "Des cellules ne sont pas remplies." & Chr(10) & "Enregistrement impossible."
    Exit Sub
End If
et une MFC sur les cellules à remplir. Elles sont rouge si vides.

( ce qui n'empêchera pas un enregistrement par Enregistrer sous )
 
Dernière édition:

phoceenjo

XLDnaute Nouveau
Bonjour Sylvanu et merci beaucoup pour ce code.

Je l'ai rentré et il fonctionne parfaitement.

Comment faire si mon champs se trouve dans des cellules fusionnées ?
Je te prie de m'excuser mais c'est quoi une MFC ? en effet cela serait super que les champs n'ayant pas été remplies puissent être visuellement identifiable.

Merci d'avance pour ton aide.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Un ex en PJ.
Une MFC est une mise en forme conditionnelle, elle est accessible par Accueil/Mise en forme conditionnelle/Gérer les règles.
Ici j'ai utilisé : =G6="" et appliqué à G6, I6, G9,I9.
Si ces cellules sont vides elles sont rouges sinon elles sont "normales"
C'est une fonction importante car simple elle permet de faire plein de choses, en particulier rendre bien plus lisible de grands tableau de données.
En PJ2 j'ai mis mon tuto sur les MFC.
 

Pièces jointes

  • Fichier test (2).xlsm
    63.3 KB · Affichages: 3
  • 1- Tuto - MFC.xlsx
    215.6 KB · Affichages: 3

phoceenjo

XLDnaute Nouveau
Merci beaucoup pour cette explication, je vais me pencher sur ton tuto.

J'ai une dernière sollicitation sans vouloir abuser de ta gentillesse.

je souhaiterais qu'en appuyant sur le bouton enregistrer une fois que tout les champs soit remplies que ces champs soit effacés pour retrouver un document vierge a l'utilisation suivante.
Difficulté supplémentaire, j'ai mis un code pour qu'en appuyant sur enregistrer le fichier soit transformé en PDF et sauvegardé dans un autre fichier que celui d'origine.
Est ce que mon souhait est réalisable
 

Pièces jointes

  • Fichier test.xlsm
    304.4 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Voir PJ.
1- J'ai mis les cellules concernées en rouge par MFC. Et modifié le code pour éviter les multiples OU :
VB:
Vide = 0 ' Variable vaut 1 si une cellule est vide
Tablo = Array([G6], [I6], [G9], [I9], [E17:E29], [E37:E40]) ' On définit dans le tableau les cellules qui doivent être non vides
' On vérifie qu'aucune cellule désignée n'est vide
For i = 0 To UBound(Tablo)
    For Each cell In Tablo(i)
        If cell.Value = "" Then Vide = 1: Exit For
    Next cell
    ' Si Vide =1 donc une cellule vide donc on émet un message et on sort.
    If Vide = 1 Then
        MsgBox "Des cellules ne sont pas remplies." & Chr(10) & "Enregistrement impossible."
        Exit Sub
    End If
Next i
2- J'ai définit le chemin d'enregistrement :
Code:
Chemin = "C:\Users\REDIF\OneDrive - REDIF\REDIF - Documents\Registre d'exploitation\Journalier\" ' Ne pas oublier le "\ à la fin
NomFichier = "Cabine 1 - " & Format(Date, "yyyy-mm-dd") & ".pdf"
 ChDir Chemin
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
3- Remettre les cellules concernées vides avec :
Code:
' On vide les cellules, à mon avis inutile car ensuite on quitte le fichier sans enregistrer
For i = 0 To UBound(Tablo)
    For Each cell In Tablo(i)
        cell.Value = ""
    Next cell
Next i
4-
le fichier soit transformé en PDF et sauvegardé dans un autre fichier que celui d'origine.
Pas compris, c'est déjà le cas. Le fichier est sauvegardé en pdf là où le chemin est déclaré, puis le fichier XL est quitter sans enregistrer.
 

Pièces jointes

  • Fichier test (3).xlsm
    64.6 KB · Affichages: 4

phoceenjo

XLDnaute Nouveau
Je me permets de revenir vers vous car pour un fichier similaire, le code ne fonctionne pas, un problème de sauvegarde.


Sub enregistrer()
Vide = 0 ' Variable vaut 1 si une cellule est vide
Tablo = Array([I1], [I2], [G5], [H5], [I5], [J5], [F7], [H7], [I12], [D18], [F18], [D23], [E23], [G23], [H23], [D25], [E25], [G25], [H25], [D27], [E27], [G27], [H27], [D35], [E35], [D37], [E37], [D22], [D39], [E39], [D47], [E47], [D49], [E49], [D51], [E51], [D53], [E53], [D55], [E55], [D57], [E57], [D64], [D66], [D68], [E69], [G69], [D70], [E71], [G71], [D72], [D74], [D76], [D78], [D83], [D87], [E87], [C89], [F87], [A92]) ' On définit dans le tableau les cellules qui doivent être non vides
' On vérifie qu'aucune cellule désignée n'est vide
For i = 0 To UBound(Tablo)
For Each cell In Tablo(i)
If cell.Value = "" Then Vide = 1: Exit For
Next cell
' Si Vide =1 donc une cellule vide donc on émet un message et on sort.
If Vide = 1 Then
MsgBox "Veuillez remplir tous les champs." & Chr(10) & "Enregistrement impossible."
Exit Sub
End If
Next i
Chemin = "C:\Users\REDIF\OneDrive - REDIF\REDIF - Documents\Registre d'exploitation\Journalier\" ' Ne pas oublier le "\ à la fin
NomFichier = "Cabine 1 - " & Format(Date, "yyyy-mm-dd") & ".pdf"
ChDir Chemin
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

' On vide les cellules, à mon avis inutile car ensuite on quitte le fichier sans enregistrer
For i = 0 To UBound(Tablo)
For Each cell In Tablo(i)
cell.Value = ""
Next cell
Next i
' On quitte le fichier sans enregistrer
ActiveWorkbook.Close False
End Sub


Pensez vous pouvoir trouver le problème ?

En vous remerciant d'avance
 

Pièces jointes

  • test 2.xlsm
    57.4 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
J'ai testé cette PJ en mettant le fichier sur le bureau, ça marche impeccable.
( Regardez le code, je l'ai simplifié pour les cellules vides. )
A mon avis, c'est votre chemin qui est erroné :
"C:\Users\REDIF\OneDrive - REDIF\REDIF - Documents\Registre d'exploitation\Journalier\"
Ce dossier existe-il ?
( J'ai testé sur mon Onedrive, cela marche aussi. )
1695396289035.png
 

Pièces jointes

  • Cabine 1 - 2023-09-22.pdf
    113.3 KB · Affichages: 1

phoceenjo

XLDnaute Nouveau
Sub enregistrer()
Vide = 0 ' Variable vaut 1 si une cellule est vide
Tablo = Array([I1], [I2], [G5], [H5], [F7], [H7], [I12], [D18], [E18], [D22:D24], [E22:E24], [G22:G24], [H22:H24], [D31:D33], [E31:E33], [D36], [E36], [D39:D44], [E39:E44], [D50], [D51], [D53], [E53], [G53], [D55:D59], [E55], [G55], [D63], [E63], [C67], [D66], [E66], [F66]) ' On définit dans le tableau les cellules qui doivent être non vides
' On vérifie qu'aucune cellule désignée n'est vide
For i = 0 To UBound(Tablo)
For Each cell In Tablo(i)
If cell.Value = "" Then Vide = 1: Exit For
Next cell
' Si Vide =1 donc une cellule vide donc on émet un message et on sort.
If Vide = 1 Then
MsgBox "Veuillez remplir tous les champs." & Chr(10) & "Enregistrement impossible."
Exit Sub
End If
Next i

Chemin = "C:\Users\REDIF\OneDrive - REDIF\REDIF - Documents\Registre d'exploitation\Hebdomadaire\" ' Ne pas oublier le "\ à la fin
NomFichier = "Gare 1 - " & "semaine - " & NumSem & ".pdf"
ChDir Chemin
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

' On vide les cellules, à mon avis inutile car ensuite on quitte le fichier sans enregistrer
For i = 0 To UBound(Tablo)
For Each cell In Tablo(i)
cell.Value = ""
Next cell
Next i
' On quitte le fichier sans enregistrer
ActiveWorkbook.Close False
End Sub




Manque comme cellules [E55:E59], [A70]
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Testez cette PJ. Sur mon PC elle marche correctement, même en rajoutant cellules [E55:E59], [A70].
J'ai rajouté un message lorsque l'opération de test a été passé avec succès. Vous devez avoir ce message :
1695631033072.png

D'ailleurs il n'y a aucune raison que cela plante car un array peut avoir des dizaines de milliers de données sans broncher.
1695630585270.png


Dernier point, ne sachant sous quel OS vous tournez: Pouvez vous testez en changeant de dossier dont le nom ne comporterait pas de signes particulier comme l'apostrophe.
Sur XL2007 et Windows 10, cela ne pose pas de problème. Mais testez quand même.
 

Pièces jointes

  • Enregistrer.xlsm
    18 KB · Affichages: 2

Discussions similaires

Statistiques des forums

Discussions
313 277
Messages
2 096 764
Membres
106 745
dernier inscrit
Krisbret