Ver originales (Francés)

Macro, si la celda está vacía, mostrar un mensaje + detener la ejecución.

Resuelto
Alexver -  
```vba
Sub ajouter_un_produit()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Sheets("ajout_produit_composant").Range("D3:D15,G3:G16")
If IsEmpty(cell.Value) Then
MsgBox "Veuillez répondre à toutes les questions."
Exit Sub
End If
Next cell
Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15").Copy
Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(1, 0)
Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
Application.ScreenUpdating = False
Sheets("ajout_produit_composant").Range("G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").Copy
Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(0, 13)
Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").ClearContents
Application.CutCopyMode = False
End Sub
```

4 respuestas

  1.  pijaku Moderador
    Hola,
    1- Si todas tus celdas son contiguas, puedes usar la sintaxis: Range("A1:A10").
    En tu ejemplo:
    Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15")
    se escribe ventajosamente:
    Range("D3:D15")

    2- Para tu prueba:
    Debes realizar un bucle sobre este Range.
    Puedes proceder así, añade este código al principio de tu macro: 
    Dim MaPlage As Range, Cel As Range Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15") For Each Cel In MaPlage 'para todas las celdas del rango If Cel.Value = "" Then 'si está vacía entonces 'mensaje al usuario MsgBox "La celda: " & Cel.Address & " no está completada." 'salida del procedimiento Exit Sub End If Next


    Cordialmente,
    Franck P
    5
    1. Alexver Autor
      Gracias pijaku por tu respuesta, es exactamente eso.

      En cuanto a la sintaxis, es cierto que la mía era un poco complicada. Así que la he modificado en consecuencia, dado que los diferentes cuestionarios que he tenido que crear no siempre son contiguos.

      Para realizar el mismo trabajo en las celdas G, he agregado otra boucle al final.
      Intenté poner Range("D3:D15;G3:G16") pero no funcionó.

      Gracias por compartir tus conocimientos, pijaku. ¡Que tengas un buen día! :)

      Macro final:

      Sub agregar_un_producto()

      Dim MiRango As Range, Cel As Range

      Set MiRango = Sheets("ajustar_producto_componente").Range("D3:D15")
      For Each Cel In MiRango 'para todas las celdas del rango
      If Cel.Value = "" Then 'si está vacía entonces
      'mensaje al usuario
      MsgBox "La celda: " & Cel.Address & " no está llena."
      'salir del procedimiento
      Exit Sub
      End If
      Next

      Set MiRango = Sheets("ajustar_producto_componente").Range("G3:G15")
      For Each Cel In MiRango 'para todas las celdas del rango
      If Cel.Value = "" Then 'si está vacía entonces
      'mensaje al usuario
      MsgBox "La celda: " & Cel.Address & " no está llena."
      'salir del procedimiento
      Exit Sub
      End If
      Next

      Application.ScreenUpdating = False
      Sheets("ajustar_producto_componente").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15").Copy
      Set UltimaFila = Sheets("tabla").Range("$A$65536").End(xlUp).Offset(1, 0)
      UltimaFila.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
      Application.ScreenUpdating = False
      Sheets("ajustar_producto_componente").Range("G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").Copy
      Set UltimaFila = Sheets("tabla").Range("$A$65536").End(xlUp).Offset(0, 13)
      UltimaFila.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
      Sheets("ajustar_producto_componente").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").ClearContents
      Application.CutCopyMode = False

      End Sub
      0
      1. pijaku Moderador
        La syntaxe est correcte.
        0
    2. foo
      Hola

      Aquí está tu macro modificada
      A probar, por supuesto

      Sub añadir_un_producto()
      Application.ScreenUpdating = False
      With Feuil2
      For L = 3 To 13
      If .Range("D" & L).Value = "" Then
      MsgBox "Por favor, responda a todas las preguntas"
      Exit Sub
      End If
      Next
      For L = 3 To 16
      If .Range("G" & L).Value = "" Then
      MsgBox "Por favor, responda a todas las preguntas"
      Exit Sub
      End If
      Next
      .Range("D3:D15").Copy
      DerLigne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
      Feuil1.Range("A" & DerLigne).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
      .Range("G3:G16").Copy
      DerLigne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
      Feuil1.Range("A" & DerLigne).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
      .Range("D3:D15").ClearContents
      .Range("G3:G16").ClearContents
      End With
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
      End Sub

      A+

      Maurice
      0
      1. Alexver Autor
        Gracias Maurice, no pude probar el efecto porque incluso después de haber llenado mis preguntas, el cuadro de mensaje permanece y la macro no se ejecuta.
        0