Eliminar autoshapes sin eliminar validación
Tengo el siguiente código:
Dim autoforma As Shape
For Each autoforma In ActiveSheet.Shapes
autoforma.Delete
Next autoforma
Range("A1").Select
Pero resulta que en donde tengo que borrar las formas, tengo celdas en donde hay validación de datos y cuando quiero seleccionar una de las opciones de la lista, no puedo porque esa forma también se borro.
Espero haberme explicado bien y gracias de antemano por la respuesta
Dim autoforma As Shape
For Each autoforma In ActiveSheet.Shapes
autoforma.Delete
Next autoforma
Range("A1").Select
Pero resulta que en donde tengo que borrar las formas, tengo celdas en donde hay validación de datos y cuando quiero seleccionar una de las opciones de la lista, no puedo porque esa forma también se borro.
Espero haberme explicado bien y gracias de antemano por la respuesta
1 Respuesta
Respuesta de Elsa Matilde
1
1
Elsa Matilde, https://www.youtube.com/c/ElsaMatilde
Creo que aquí hay un error de concepto... las autoformas o cualquier objeto que dibujes en la hoja, se colocan x encima de las celdas, aunque le des el tamaño exacto y te parezca que está en la celda.
Por tal razón difícilmente se te borre la validación de datos, que es una lista en la celda...
Salvo que estés llamando 'validación' a un control del tipo combobox o cuadro combinado, que sí es un objeto...
En ese caso debieras evaluar su nombre en la rutina antes de eliminarlo. Por Ej:
For Each autoforma In ActiveSheet.Shapes
if autoforma.name <> "Lista desplegable 1" then autoforma.Delete
Next autoforma
Sdos. Si esto resolvió tu consulta no olvides finalizarla.
Por tal razón difícilmente se te borre la validación de datos, que es una lista en la celda...
Salvo que estés llamando 'validación' a un control del tipo combobox o cuadro combinado, que sí es un objeto...
En ese caso debieras evaluar su nombre en la rutina antes de eliminarlo. Por Ej:
For Each autoforma In ActiveSheet.Shapes
if autoforma.name <> "Lista desplegable 1" then autoforma.Delete
Next autoforma
Sdos. Si esto resolvió tu consulta no olvides finalizarla.
Hola Elsa gracias por la respuesta.
Tienes razón, el código no esta borrando la validación de datos, que es en sí lo que se "borra" y me refiero a lista que está EN la celda, de cualquier forma ya verifiqué y el problema más bien es en la máquina de uno de los usuarios porque en mi máquina sí funciona bien.
¿Por qué será que desaparece la validación? ¿Algún problema con la seguridad de las macros o algo así? ¿O más bien hay que hacer algo directamente en excel?
Saludos y gracias de antemano por la respuesta
Tienes razón, el código no esta borrando la validación de datos, que es en sí lo que se "borra" y me refiero a lista que está EN la celda, de cualquier forma ya verifiqué y el problema más bien es en la máquina de uno de los usuarios porque en mi máquina sí funciona bien.
¿Por qué será que desaparece la validación? ¿Algún problema con la seguridad de las macros o algo así? ¿O más bien hay que hacer algo directamente en excel?
Saludos y gracias de antemano por la respuesta
La validación (del menú Datos, Validación) debe funcionar bien en todos los equipos.
Ahora... si la hoja se protege (sin opción de seleccionar celdas bloqueadas) y la celda con la validación está bloqueada, no podrás seleccionarla y por lo tanto te parecerá que ya no tiene la validación (no se vé la flecha)
La validación en sí, no utiliza macros, por lo que no interesa el nivel de seguridad.
Por lo tanto debieras revisar: la protección de la hoja, si existe alguna rutina que afecte a esa hoja (Worksheet_Selection..., Change, etc)
Revisa y comentame si encontraste algo. Podes enviarme tu libro para que lo vea y 'desempate' ;)
El correo lo encontrarás en mi sitio.
Ahora... si la hoja se protege (sin opción de seleccionar celdas bloqueadas) y la celda con la validación está bloqueada, no podrás seleccionarla y por lo tanto te parecerá que ya no tiene la validación (no se vé la flecha)
La validación en sí, no utiliza macros, por lo que no interesa el nivel de seguridad.
Por lo tanto debieras revisar: la protección de la hoja, si existe alguna rutina que afecte a esa hoja (Worksheet_Selection..., Change, etc)
Revisa y comentame si encontraste algo. Podes enviarme tu libro para que lo vea y 'desempate' ;)
El correo lo encontrarás en mi sitio.
Hola Elsa buen día, perdón por la tardanza pero te envío el código completo
Private Sub FORMATO()
Call AUTO_CLOSE
Sheets("FORMATO").Select
Range("C2").Select
ActiveCell = "=TODAY()" 'FECHA
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B4").Select 'SOLICITANTE
SOLICITANTE = InputBox("INTRODUCE EL NOMBRE DE QUIEN SOLICITA", "NOMBRE", "JUAN MIGUEL ESCAMILLA")
ActiveCell = SOLICITANTE
ActiveCell = UCase(ActiveCell)
Range("B5").Select
VIA.Show
Range("B7").Select
SOLICITA.Show
Application.ScreenUpdating = False
Range("E6").Select 'WORK ORDER
ActiveCell.FormulaR1C1 = _
"=IF(R[1]C[-3]=0,"""",IF(R[1]C[-3]=""UNIFICACIONES"","""",IF(R[1]C[-3]<>""UNIFICACIONES"",""WORK ORDER:"")))"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B8").Select
Application.ScreenUpdating = True
TIPO.Show
Range("B10").Select
CARGO.Show
Range("E8").Select
NOTAS.Show
Range("A12").Select 'LISTA DE REQUERIMIENTOS
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[1]<>0,CONCATENATE(""LISTA DE "",R[-5]C[1],"":""),"""")"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("G13").Select 'ESTATUS
ActiveCell.FormulaR1C1 = "=IF(LEN(R[-1]C[-6])<>0,""ESTATUS:"","""")"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A13").Select 'LISTA
MsgBox ("INGRESA LA LISTA DE REQUERIMIENTOS" + Chr(13) + "" + Chr(13) + "RECUERDA QUE:" + Chr(13) + "SI VAS A COPIAR Y PEGAR, DEBEN SER SOLO LOS VALORES O TEXTO")
End Sub
Private Sub CONSECUTIVO()
Sheets("CONSECUTIVO").Select
Application.ScreenUpdating = False
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Rows("3:3").Select
Selection.Copy
Rows("2:2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("C2:J2").Select
Selection.ClearContents
Range("B2").Select 'CONSECUTIVO
ActiveCell.FormulaR1C1 = "=R[1]C+1"
Range("A2").Select 'FOLIO
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(""GNP-"",TEXT(TODAY(),""aa""),TEXT(TODAY(),""mm""),""-"",TEXT(R[0]C[1],""000""))"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(0, 2).Select 'FECHA
ActiveCell = Sheets("FORMATO").Cells(2, 3)
ActiveCell.Offset(0, 1).Select 'SOLICITANTE
ActiveCell = Sheets("FORMATO").Cells(4, 2)
ActiveCell.Offset(0, 1).Select 'VIA
ActiveCell = Sheets("FORMATO").Cells(5, 2)
ActiveCell.Offset(0, 1).Select 'SOLICITA
ActiveCell = Sheets("FORMATO").Cells(7, 2)
ActiveCell.Offset(0, 1).Select 'TIPO
ActiveCell = Sheets("FORMATO").Cells(8, 2)
ActiveCell.Offset(0, 1).Select 'CARGO
ActiveCell = Sheets("FORMATO").Cells(10, 2)
Range("A1").Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Sheets("FORMATO").Select
Range("G2").Select
ActiveCell = Sheets("CONSECUTIVO").Cells(2, 1)
Sheets("FORMATO").Select
Sheets("FORMATO").Copy
Dim autoforma As Shape
For Each autoforma In ActiveSheet.Shapes
autoforma.Delete
Next autoforma
Range("A1").Select
'ChDir "C:\Documents and Settings\Villegas\My Documents\SOLICITUDES GNP" 'LUZ
ChDir "C:\Documents and Settings\Marleyne Huerta\My Documents" 'MARLEYNE
ActiveWorkbook.SaveAs Filename:=Range("G2").Value, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Application.Dialogs(xlDialogSendMail).Show
ActiveWindow.Close
Sheets("FORMATO").Select
Range("A1").Select
ActiveWorkbook.SAVE
Application.ScreenUpdating = True
End Sub
Private Sub AUTO_CLOSE()
Application.ScreenUpdating = False
Sheets("FORMATO").Select
Range("C2,G2,B4,F4,B5:B10,A13:G118,A12,G13,E8").Select
Selection.ClearContents
Range("A1").Select
Application.DisplayAlerts = False
ActiveWorkbook.SAVE
Application.ScreenUpdating = True
End Sub
Sub ABRIR()
Dim file_open As Variant
Dim org_workbook As Variant
org_workbook = ActiveWorkbook.Name
file_open = Application.GetOpenFilename()
On Error Resume Next
Workbooks.Open Filename:=file_open
End Sub
Sub ACTUALIZAR()
Call ABRIR
ARCHIVO = ActiveWorkbook.Name
MYWORKBOOK = ARCHIVO
MIHOJA = ActiveSheet.Name
MYSHEET = MIHOJA
Range("F4").Select
ATENDIO = ActiveCell.Value
MYRANGE1 = ATENDIO
Range("F6").Select
WORKORDER = ActiveCell.Value
MYRANGE2 = WORKORDER
Range("G2").Select
FOLIO = ActiveCell.Value
MYRANGE3 = FOLIO
Windows("SOLICITUDES GNP.xls").Activate
Sheets("CONSECUTIVO").Select
Cells.Find(MYRANGE3).Select
'If ActiveCell.Address <> "$A" Then
'Range("M1").Select
'Else
ActiveCell.Offset(0, 8).Select
ActiveCell = MYRANGE1
ActiveCell.Offset(0, 1).Select
ActiveCell = MYRANGE2
Windows(MYWORKBOOK).Activate
ActiveWindow.Close
'End If
Windows("SOLICITUDES GNP.xls").Activate
Range("A2").Select
End Sub
Saludos
Private Sub FORMATO()
Call AUTO_CLOSE
Sheets("FORMATO").Select
Range("C2").Select
ActiveCell = "=TODAY()" 'FECHA
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B4").Select 'SOLICITANTE
SOLICITANTE = InputBox("INTRODUCE EL NOMBRE DE QUIEN SOLICITA", "NOMBRE", "JUAN MIGUEL ESCAMILLA")
ActiveCell = SOLICITANTE
ActiveCell = UCase(ActiveCell)
Range("B5").Select
VIA.Show
Range("B7").Select
SOLICITA.Show
Application.ScreenUpdating = False
Range("E6").Select 'WORK ORDER
ActiveCell.FormulaR1C1 = _
"=IF(R[1]C[-3]=0,"""",IF(R[1]C[-3]=""UNIFICACIONES"","""",IF(R[1]C[-3]<>""UNIFICACIONES"",""WORK ORDER:"")))"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B8").Select
Application.ScreenUpdating = True
TIPO.Show
Range("B10").Select
CARGO.Show
Range("E8").Select
NOTAS.Show
Range("A12").Select 'LISTA DE REQUERIMIENTOS
ActiveCell.FormulaR1C1 = _
"=IF(R[-5]C[1]<>0,CONCATENATE(""LISTA DE "",R[-5]C[1],"":""),"""")"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("G13").Select 'ESTATUS
ActiveCell.FormulaR1C1 = "=IF(LEN(R[-1]C[-6])<>0,""ESTATUS:"","""")"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A13").Select 'LISTA
MsgBox ("INGRESA LA LISTA DE REQUERIMIENTOS" + Chr(13) + "" + Chr(13) + "RECUERDA QUE:" + Chr(13) + "SI VAS A COPIAR Y PEGAR, DEBEN SER SOLO LOS VALORES O TEXTO")
End Sub
Private Sub CONSECUTIVO()
Sheets("CONSECUTIVO").Select
Application.ScreenUpdating = False
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Rows("3:3").Select
Selection.Copy
Rows("2:2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("C2:J2").Select
Selection.ClearContents
Range("B2").Select 'CONSECUTIVO
ActiveCell.FormulaR1C1 = "=R[1]C+1"
Range("A2").Select 'FOLIO
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(""GNP-"",TEXT(TODAY(),""aa""),TEXT(TODAY(),""mm""),""-"",TEXT(R[0]C[1],""000""))"
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(0, 2).Select 'FECHA
ActiveCell = Sheets("FORMATO").Cells(2, 3)
ActiveCell.Offset(0, 1).Select 'SOLICITANTE
ActiveCell = Sheets("FORMATO").Cells(4, 2)
ActiveCell.Offset(0, 1).Select 'VIA
ActiveCell = Sheets("FORMATO").Cells(5, 2)
ActiveCell.Offset(0, 1).Select 'SOLICITA
ActiveCell = Sheets("FORMATO").Cells(7, 2)
ActiveCell.Offset(0, 1).Select 'TIPO
ActiveCell = Sheets("FORMATO").Cells(8, 2)
ActiveCell.Offset(0, 1).Select 'CARGO
ActiveCell = Sheets("FORMATO").Cells(10, 2)
Range("A1").Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Sheets("FORMATO").Select
Range("G2").Select
ActiveCell = Sheets("CONSECUTIVO").Cells(2, 1)
Sheets("FORMATO").Select
Sheets("FORMATO").Copy
Dim autoforma As Shape
For Each autoforma In ActiveSheet.Shapes
autoforma.Delete
Next autoforma
Range("A1").Select
'ChDir "C:\Documents and Settings\Villegas\My Documents\SOLICITUDES GNP" 'LUZ
ChDir "C:\Documents and Settings\Marleyne Huerta\My Documents" 'MARLEYNE
ActiveWorkbook.SaveAs Filename:=Range("G2").Value, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Application.Dialogs(xlDialogSendMail).Show
ActiveWindow.Close
Sheets("FORMATO").Select
Range("A1").Select
ActiveWorkbook.SAVE
Application.ScreenUpdating = True
End Sub
Private Sub AUTO_CLOSE()
Application.ScreenUpdating = False
Sheets("FORMATO").Select
Range("C2,G2,B4,F4,B5:B10,A13:G118,A12,G13,E8").Select
Selection.ClearContents
Range("A1").Select
Application.DisplayAlerts = False
ActiveWorkbook.SAVE
Application.ScreenUpdating = True
End Sub
Sub ABRIR()
Dim file_open As Variant
Dim org_workbook As Variant
org_workbook = ActiveWorkbook.Name
file_open = Application.GetOpenFilename()
On Error Resume Next
Workbooks.Open Filename:=file_open
End Sub
Sub ACTUALIZAR()
Call ABRIR
ARCHIVO = ActiveWorkbook.Name
MYWORKBOOK = ARCHIVO
MIHOJA = ActiveSheet.Name
MYSHEET = MIHOJA
Range("F4").Select
ATENDIO = ActiveCell.Value
MYRANGE1 = ATENDIO
Range("F6").Select
WORKORDER = ActiveCell.Value
MYRANGE2 = WORKORDER
Range("G2").Select
FOLIO = ActiveCell.Value
MYRANGE3 = FOLIO
Windows("SOLICITUDES GNP.xls").Activate
Sheets("CONSECUTIVO").Select
Cells.Find(MYRANGE3).Select
'If ActiveCell.Address <> "$A" Then
'Range("M1").Select
'Else
ActiveCell.Offset(0, 8).Select
ActiveCell = MYRANGE1
ActiveCell.Offset(0, 1).Select
ActiveCell = MYRANGE2
Windows(MYWORKBOOK).Activate
ActiveWindow.Close
'End If
Windows("SOLICITUDES GNP.xls").Activate
Range("A2").Select
End Sub
Saludos
Que sea una persona que se defienda bastante bien con el Excel no significa que sea 'maga'... imposible revisar tu código más allá de leerlo un poco.
No veo que tengas rutinas del tipo Worksheet_change, si bien hay algunas instrucciones que limpian celdas. Pero como ya está comprobado que en tu equipo funciona bien, solo debo reiterar que revises la protección de hojas.
Sdos
Elsa
No veo que tengas rutinas del tipo Worksheet_change, si bien hay algunas instrucciones que limpian celdas. Pero como ya está comprobado que en tu equipo funciona bien, solo debo reiterar que revises la protección de hojas.
Sdos
Elsa
- Compartir respuesta
- Anónimo
ahora mismo