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

[phoceenjo]

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

 

[sylvanu]

Bonjour phoceenjo, et bienvenu sur XLD,
Peut être simplement en commençant la macro Enregistrer par :

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 )

 

[phoceenjo]

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]

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.

 

[phoceenjo]

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

 

[sylvanu]

Re,
Voir PJ.
1- J'ai mis les cellules concernées en rouge par MFC. Et modifié le code pour éviter les multiples OU :

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 :

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 :

' 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.

 

[phoceenjo]

Merci beaucoup pour ce code et le temps passé.

Ça fonctionne parfaitement, heureusement que vous étiez la pour m'aider.

Je vous souhaite une bonne journée et par avance un bon weekend.

 

[phoceenjo]

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

 

[sylvanu]

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. )

 

[sylvanu]

Re,
Ouvrez cette PJ et appuyez sur le bouton.
Au moins on saura si votre chemin est correct.

 

[phoceenjo]

Bonjour,

Merci pour votre réponse,

J'ai mis votre fichier sur mon bureau et appuyé sur le bouton test et je n'ai aucun message qui s'affiche.

je suis sur du chemin.

Je vous souhaite une bonne journée et vous remercie d'avance.

 

[phoceenjo]

J'ai redémarré l'ordinateur et cette fois ca à l'air de fonctionner.

Je fais l'ensemble du test et je reviens vers vous.

 

[phoceenjo]

Je pense avoir trouver le problème, dés que je dépasse un certain nombres de cellules a vérifier cela fait planter la macro.

Pouvez vous m'aidez s'il vous plait ?

 

[phoceenjo]

Sub enregistrer()
Vide = 0 ' Variable vaut 1 si une cellule est vide
Tablo = Array([I1], [I2], [G5], [H5], [F7], [H7], [I12], [D18], [E18], [D22😀24], [E22:E24], [G22:G24], [H22:H24], [D31😀33], [E31:E33], [D36], [E36], [D39😀44], [E39:E44], [D50], [D51], [D53], [E53], [G53], [D55😀59], [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]

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 :

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.

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.