En esta macro lograr que la imagen que se agrega, este sin proteger

Necesitaría que en esta Macro :

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
.Selection.Locked = False
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

La imagen que se agrega en la columna "D", salga sin estar protegida.
O que en esta macro :

Sub PEDIDOS_FALCATA()
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' Guardar archivo en G
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
ruta = "G:\Factura\7Pedidos.xls"
Worksheets("P.FALCATA").Select
Selection.Copy
Workbooks.Open ruta
Worksheets("FALCATA").Select
Range("A1").End(xlDown).Select
Selection.Offset(0, 1).Select
Selection.End(xlUp).Select
Selection.Offset(2, 0).Select 'Dirigirse a la ultima celda que contiene valores
ActiveSheet.Paste 'Pega valores
Application.CutCopyMode = False
Workbooks("7Pedidos.xls").Close Savechanges:=True
End Sub

Me grabe la imagen que esta protegida, porque al estar protegida no me la exporta, que es el problema que tengo.
No se si es mejor rectificar en la primera macro o en la segunda