XL 2010 Etendre macro à plusieurs lignes

[RémiCom]

Bonjour,

Je suis débutant en VBA.
J'essai d'écrire un code qui je pense est très simple, et je pense même avoir lu des parties de réponse sur le forum mais je ne suis toujours pas arrivé à mes fins
J'ai écris une macro qui me permet de rendre deux champs obligatoires si un cellule est non vide (voir ci-dessous)
Maintenant j'ai besoin de faire exactement la même chose mais appliqué à plusieurs lignes, lignes 2 à 2000.
En vain je n'arrive pas à l'écrire.
Ce que je recherche est simplement que si la cellule BX est non vide alors les champs CX et FX deviennent obligatoire et ceux étendu sur 2000 lignes.
Quelqu'un pourrait m'aider.

En vous remerciant.
Salutations

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If Range("B2") <> "" Then
If Range("C2") = "" Or Range("F2") = "" Then
Cancel = True
MsgBox ("Champ obligatoire")

End If
End If

End Sub

 

[Dranreb]

Bonsoir.
Essayez comme ça :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Plg As Range
On Error Resume Next
Set Plg = [B2:B2000].SpecialCells(xlCellTypeConstants, 23).EntireRow
If Err Then Exit Sub
Set Plg = Intersect([C:C,F:F], Plg)
If Err Then Exit Sub
Set Plg = Plg.SpecialCells(xlCellTypeBlanks)
If Err Then Exit Sub
Cancel = True
Application.Goto Plg
MsgBox "Champ obligatoire", vbExclamation, "Sauvegarde"
End Sub

 

[RémiCom]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Plg As Range
On Error Resume Next
Set Plg = [B2:B2000].SpecialCells(xlCellTypeConstants, 23).EntireRow
If Err Then Exit Sub
Set Plg = Intersect([C:C,F:F], Plg)
If Err Then Exit Sub
Set Plg = Plg.SpecialCells(xlCellTypeBlanks)
If Err Then Exit Sub
Cancel = True
Application.Goto Plg
MsgBox "Champ obligatoire", vbExclamation, "Sauvegarde"
End Sub

Bonjour,

Merci beaucoup pour votre aide.
Je pense avoir compris le code et c'est bien ce que je recherche.
Mais je n'arrive pas à le faire marcher, il y a rien qui se passe lorsque j'enregistre.

 

[Dranreb]

Bonjour.
S'il ne se passe rien c'est que tout est bon.
Soit il n'y a que des cellules vides ou des formules en B2:B2000 de la feuille active au moment de la sauvegarde,
soit il y a des formules ou des valeurs figée, mais pas de cellule vide aux colonnes C et F des lignes où il y a des valeurs figées en colonne B.
Votre macro est elle bien écrite dans le module objet ThisWorkbook et non pas dans un module standard ?

 

[RémiCom]

Bonjour,
en effet je ne l'avais pas mis dans Thisworkbook, mais sur le fichier correspondant à mon onglet, le fichier juste au-dessus.
Donc ca marche très bien merci beaucoup! ... J'ai du coup rajouté des champs obligatoires.

Par contre si possible j'aimerais comprendre cette ligne: Set Plg = [B2:B2000].SpecialCells(xlCellTypeConstants, 23).EntireRow
-> On va lire dans la plage B2:B2000 si il y a une valeur constante mais le chiffre 23 a quoi sert-il?

En vous remerciant.

Salutations

 

[Dranreb]

Bonsoir.
23 est la somme des types de constantes désirés qui les inclut tous: nombres, textes, valeurs logiques et erreurs. C'est 1 + 2 + 4 +16, et je viens de voir que dans ce cas on peut aussi l'omettre.

 

[RémiCom]

OK merci beaucoup pour votre aide.

Salutations

 

[RémiCom]

Bonjour,

Je reviens sur ce topic.
La formule que vous m'aviez indiqué marche très bien!
Je suis entrain de faire un nouvelle essai similaire pour lequel j'aimerais que si les cellules (en occurrence (I12:I2000)) sont remplis, une des deux plages de cellules (M12:M2000) ou (N12:N2000) soit obligatoirement rempli.
Donc comme dans le cas précédent il y a des champs obligatoires si une des cellules est remplie mais avec le choix de soit écrire dans l'une soit écrire dans l'autre.

J'espère être assez clair.
J'ai essayé de rajouter des "OR" dans la formule précédente mais en vain.

En vous remerciant de votre aide.

Salutations

 

[Dranreb]

Bonjour.
Essayez en utilisant ces fonctions de service. Là vous pouvez spécifier une expression R1C1 utilisant les fonction AND et OR d'Excel :

Function ColLignesOùRelat(ByVal CelDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Rem. ——— Cellules partant de CelDéb dans sa colonne où la colonne ColQuoi est en relation Opé avec Valeur.
Set ColLignesOùRelat = Intersect(LignesOùRelat(CelDéb, ColQuoi, Opé, Valeur), CelDéb.EntireColumn)
End Function

Function LignesOùRelat(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Rem. ——— Lignes entières partant de LigneDéb où la colonne ColQuoi est en relation Opé avec une Valeur.
If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
  """", """""") & """" Else Valeur = Trim$(Str$(Valeur))
Set LignesOùRelat = LignesOùCondR1C1(LigneDéb, CondR1C1:="RC" & ColQuoi & Opé & Valeur)
End Function

Function ColLignesOùCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Cellules partant de CélDéb dans sa colonne dont les lignes vérifient une condition R1C1 CondR1C1.
On Error Resume Next
Set ColLignesOùCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
End Function

Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb qui vérifient une condition R1C1 CondR1C1.
Dim Lignes As Range, ColTrv As Range
On Error Resume Next
With LigneDéb.Worksheet.UsedRange
  Set Lignes = LigneDéb.EntireRow.Resize(.Rows.Count + .Row - LigneDéb.Row)
  If Err Then Exit Function
  Set ColTrv = Intersect(.Columns(.Columns.Count + 1), Lignes): End With
ColTrv.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
Set LignesOùCondR1C1 = ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow
ColTrv.Delete xlShiftToLeft
End Function

 

[Dranreb]

Ceci, par exemple :

Sub test()
Dim R As Range
Set R = ColLignesOùCondR1C1(ActiveSheet.[M12:N12], "AND(NOT(ISBLANK(RC9)),ISBLANK(RC13),ISBLANK(RC14))")
If R Is Nothing Then Exit Sub
Application.Goto R
End Sub

 

[RémiCom]

Merci de votre Aide.
J'ai essayé avec le code que vous m'avez donné mais je n'y arrive pas. Dans "ColLignesoùCondR1C" je saisi pas bien ce que je dois mettre.
Dans le précédent code on avait écrit cela:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Plg As Range
On Error Resume Next
Set Plg = [I12:I2000].SpecialCells(xlCellTypeConstants, 23).EntireRow
If Err Then Exit Sub
Set Plg = Intersect([C:C,F:F], Plg) Au lieu décrire cette condition je voudrais écrire que M:M ou N:N est obligatoire l'un ou l'autre validerait la condition. Les deux marchent aussi mais pas obligatoirement, et aucun des deux ne marche pas.
If Err Then Exit Sub
Set Plg = Plg.SpecialCells(xlCellTypeBlanks)
If Err Then Exit Sub
Cancel = True
Application.Goto Plg
MsgBox "Champ obligatoire", vbExclamation, "Sauvegarde"
End Sub

 

[RémiCom]

Je sais pas comment l'écrire. Pourriez-vous m'éclaircir svp?

Merci Bonne soirée

 

[Dranreb]

Ben je vous l'ai écrit poste #10, reprenez le tel quel.

 

[RémiCom]

Bonjour Dranreb,

Bonne année et meilleurs vœux.
je ne suis pas encore assez calé, je n'arrive pas à faire fonctionner ce code.
J'ai copié/collé le bloc mais ca ne marche pas .
le code "colLignesoùCondR1C1" est surligné.

 

[Dranreb]

Bonjour et bonne année à vous aussi.
Elles sont au moins installées quelque part, dans un autre module à vocation utilitaire par exemple, les fonctions de service du poste #9 ?