Muy buenas!
El Excel en el que estoy trabajando es una especie de checklist para crear una factura, es decir, el Excel tiene dos pestañas, en la primera aparece todos los accesorios con su casilla de control de formulario y en la otra pestaña aparece la factura total en la que se irá realizando automáticamente y en el que se separarán los accesorios requeridos y opcionales.
EN RESUMEN:
- Primera pestaña: Estarán todos los elementos con sus casillas de control de formulario (donde están situadas en la columna A)
- Segunda pestaña: Se irá formando la factura, donde meteré la información del elemento (columna B de la primera pestaña) y el precio del elemento (columna C de la pestaña)
Mi objetivo es que todos los elementos que vaya haciendo click en la primera pestaña, que me pregunte si es opcional o no y que dependiendo lo que haya elegido, añada una fila nueva en el sitio adecuado de la Hoja2 y que la información del accesorio se pegue en la nueva fila.
Como bien he dicho en la factura que hay en la segunda pestaña ("Hoja2"), tengo que separar lo que son ACCESORIOS REQUERIDOS y ACCESORIOS OPCIONALES...
- Por una parte me gustaría que me preguntara si el accesorio es opcional o no cada vez que hago click en la casilla de control de formulario. De la manera que lo he hecho yo, me pregunta todo al final y es imposible saber de que celda o accesorio me esta hablando. En caso de que no sea posible la opción en la que me el programa me pregunte cada vez que hago click en la casilla, hay alguna manera en la que el texto que aparece en el cuadro del mensaje se modifique dependiendo la celda?
- Me da un error 400 y la verdad es que no se donde tengo el error o que es lo que falla...
Esto es lo que he hecho yo:
Sub FACTURA()
Dim n As Long
Dim m As Long
Dim v As Long
Dim Fila As Long
Dim Pregunta As String
Dim ACC As Long
Dim ACC_O As Long
m = 1
n = m + 2
v = 2
Worksheets("Hoja2").Range("A3") = "ACCESORIOS OPCIONALES"
Worksheets("Hoja2").Range("A1") = "ACCESORIOS NORMAL"
Worksheets("Hoja2").Range("A2") = "TOTAL ACCESORIOS NORMAL"
Sheets("Hoja1").Select
Worksheets("Hoja2").Range("A2:A10").Clear
Worksheets("Hoja2").Range("B2:B10").Clear
For v = 2 To Range("A" & v).End(xlDown).Row
If Range("A" & v).Value = True Then
Pregunta = MsgBox("Es un Accesorio Opcional?", vbYesNo + vbQuestion, "ACCESORIOS")
If Pregunta = vbNo Then
ACC = Worksheets("Hoja2").Range("A" & m).Value
Worksheets("Hoja2").Cells(ACC, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
m = m + 1
Worksheets("Hoja2").Range("A" & m).Value = Range("C" & v).Value
Worksheets("Hoja2").Range("B" & m).Value = Range("D" & v).Value
Else
ACC_O = Worksheets("Hoja2").Range("A" & n).Value
Worksheets("Hoja2").Cells(ACC_O, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
n = n + 1
Worksheets("Hoja2").Range("A" & n).Value = Range("C" & v).Value
Worksheets("Hoja2").Range("B" & n).Value = Range("D" & v).Value
End If
Else
v = v + 1
End If
Next v
MsgBox "Done!"
End Sub
v= es el valor de todos los accesorios que aparecen en la primera pestaña
m= es el valor donde irán añadiendo todos los accesorios necesarios
n= es el valor de la celda donde irán todos los accesorios opcionales.
Los accesorios irán uno detrás de otro pero luego, como bien se puede ver al principio, entre los accesorios requerido y accesorios opcional irán varios títulos.
Espero haberme explicado bien...Que tengáis un buen día!
Puedes expecificar en que punto te da el error?
tampoco estaría de mas subir el lbro. Con el código, si no tenemos los datos de los que tira, poco se puede hacer. De todas formas, a golpe de vista:
- Empiezas creando uns titulos en la Hoja2
- Te posiciones en la Hoja1
- Borras 2 de los 3 titulos de la Hoja2
Yo creo que te estás liando y no tienes bien controlado donde estás haciendo las cosas en cada momento. Como norma general, se debería siempre que se hace referencia a un rango, especificarlo por completo: en vez de Range("A1"), poner Sheets("Hoja1") y mucho mejor Hoja1.Range("A1")
Te recomendaría que echases un vistado a esto: Buenas prácticas en VBA
IMF_RET
Visitame en https://InformaticaMuyFacil.com