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

1 Respuesta

Respuesta
1
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.
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
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.
No te olvides de finalizar la consulta ...
Sdos
Elsa
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
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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas