Problemas con macro, haber pasado del 2003 al 2007
Al seleccionar las celdas en rojo y ejecutar la macro "Borrar Celdas Selección" me da error en :
Sub BorrarMiaSeleccion()
Application.ScreenUpdating = False ' Apagar el parpadeo de pantalla
ActiveSheet.Protect Password:="1"
Dim r As Range
For Each r In Selection
If r.Locked = False Then r.ClearContents
Dim img As Shape
On Error Resume Next
For Each img In ActiveSheet.Shapes
If Not Application.Intersect(img.TopLeftCell, Selection) Is Nothing Then
If img.Type = msoPicture Then img.Delete
End If
Next
Next
Call comenzar_las_macros_así
For Each r In Selection
'si alguna celda está desbloqueada, se cambia color de fondo y fuente blanca
If r.Locked = False Then
r.Interior.Color = RGB(255, 255, 255) 'Convierte a color blanco CELDAS SELECIONASA.
r.Font.Color = RGB(0, 0, 0) ' Convierte en Negritas la fuente (texto) de la celda activa.
End If
Next
Call finalizar_las_macros_así
End Sub
En la hoja tengo este código :
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' AGREGAR FECHA EN UNA COLUMNA
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Target.Column = 5 Then
If Cells(Target.Row, "B") = "" Then
ActiveSheet.Unprotect Password:="1"
Cells(Target.Row, "B") = Date
ActiveSheet.Protect Password:="1"
End If
End If
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' Columnas en MAYUSCULAS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Not Application.Intersect(Target, Range("F7:F2000")) Is Nothing Then
ActiveSheet.Unprotect Password:="1"
Target.Value = UCase(Target)
ActiveSheet.Protect Password:="1"
End If
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' F O T O S
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Not Intersect(Target, Columns("E")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
ActiveSheet.Unprotect Password:="1"
If Target <> "" Then
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' AGREGAR FOTOS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
'ruta = "C:\trabajo\Fotos\"
ruta = "G:\Factura\Fotos\"
imagen = Dir(ruta & Target.Value & ".*")
If imagen <> "" Then
imgactual = Cells(Target.Row, "D")
If imgactual <> "" Then
ActiveSheet.Shapes(imgactual).Delete
End If
Set etiqueta = ActiveSheet.Pictures.Insert(ruta & imagen)
With etiqueta
.ShapeRange.LockAspectRatio = msoFalse
.Left = Cells(Target.Row, "D").Left
.Top = Cells(Target.Row, "D").Top
.Height = Range(Cells(Target.Row, "D"), Cells(Target.Row + 4, "D")).Height 'alto imagen
.Width = Cells(Target.Row, "D").Width 'ancho imagen
End With
imgactiva = etiqueta.Name
Cells(Target.Row, "D") = imgactiva
Else
MsgBox "La referencia no tiene foto", vbExclamation
End If
Else
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' Eliminar FOTOS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
On Error Resume Next
If Target.Count > 1 Then Exit Sub
imgactual = Cells(Target.Row, "D")
If imgactual <> "" Then
ActiveSheet.Shapes(imgactual).Delete
End If
Cells(Target.Row, "D") = ""
Cells(Target.Row, "B") = ""
End If
ActiveSheet.Protect Password:="1"
End If
End Sub
Y me da error en el código de la hoja en la linea :
If Not Application.Intersect(Target, Range("F7:F2000")) Is Nothing Then
Que esta en el código de la hoja, y en 2003, no me daba.
He puesto el código que me diste :
If Not Intersect(Target, Range("F7:F2000")) Is Nothing Then
Pero sigue igual.