Tester des cellule Excel et enregistrer dans un autre classeur

Bonsoir,

Je suis intéresser par le développement VBA mais je suis encore débutant. Je suis serré par un projet pour le moment et je veux bien que vous m'aidez dans cette situation.

D'abord, je veux developper un bouton qui teste quelque cellule dans la feuille puis retourne un message d'erreur si vide.

Après, je veux developper un autre bouton qui enregistre la feuille dans un autre classeur avec un nom spécifique.

Enfin, le deuxième bouton ne peut pas être utiliser que si on tape un code.

Merci infiniment

Bonjour,

Ca manque d'informations alors voici une réponse de principe, qu'il faudra adapter à vos propres références :

sub Premieredemande()

dim zone as range

set zone = union(range("A1"), range("B2:C3"), range("D4")) 'à adapter

if application.counblank(zone) > 0 then
    msgbox "Veillez à remplir impérativement toutes les cellules obligatoires : " & zone.address, vbcritical
end if

end sub

sub deuxiemedemande()

nom = thisworkbook.path & "\" & "nomspecifique.xlsm" 'nom à adapter
reponse = inputbox("Saisissez le mot de passe")

if reponse = "MDP" then 'mot de passe à adapter
    activesheet.copy
    activeworkbook.close savechanges:=true, filename:=nom
end if

end sub

Cdlt,

Bonjour,

Merci infiniment pour votre réponse, ci joint vous pouvez trouver ma feuille excel. j'ai tester les 2 macros mais il n'ont pas données des résultats.

merci de les tester.

Bonjour,

J'ai un peu modifié le code, que voici :

Sub Enregistrement()

If ForcerRemplissage Then Exit Sub 'si la fonction ForcerRemplissage renvoie vrai (cad, s'il y a des vides) => sortie

nom = ThisWorkbook.Path & "\" & "01-fiche de suivi journalier A3FLEX_test.xlsm" 'nom à adapter
reponse = InputBox("Saisissez le mot de passe")

If reponse = "MDP" Then 'mot de passe à adapter
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'sauvegarde
    ActiveWorkbook.Close True 'fermeture
End If

End Sub

Function ForcerRemplissage() As Boolean

Dim zone As Range, nb&

Set zone = Union(Range("D22:S22"), Range("D29:S29"), Range("D43:S43"), Range("D48:S48"), Range("X46:BA48")) 'à adapter
nb = zone.Cells.Count

If Application.CountA(zone) < nb Then 'si certaines cellules de la plage spécifiée sont vides
    MsgBox "Veillez à remplir impérativement toutes les cellules obligatoires : " & zone.Address, vbCritical
    ForcerRemplissage = True 'renvoie vrai
End If

End Function

Vous savez, vous pouvez sélectionner toutes vos plages jaunes D22:S22, ... et les renommer (par exemple "Obligatoire").

Ensuite dans le code, vous auriez juste à remplacer ainsi la ligne d'affectation de zone : set zone = range("Obligatoire")

Alors, vous pourrez éventuellement adapter les cellules obligatoires directement depuis excel (gestionnaire de noms) au lieu de devoir faire ces modifications dans le code.

Bonne fin d'année et bon réveillon !

Cdlt,