Error al insertar imagen por código en Excel 2007

hace unos días preparé el siguiente procedimiento que en excel 2003 funciona perfectamente
sin embargo en excel 2007 no, a pesar de que en algun momento lo ha hecho y ningun cambio ha sido sustancial como para ello
el error es "No se puede obtener la propiedad Insert de la clase Pictures." y se produce en la linea marcada con <<<<<<
es decir en el momento de insertar la imagen.

Le he dado mil vueltas pero ya no se por donde mas mirar, alguna idea?

Muchas gracias.

'*******************************************************************************
'* InsertaImagen
'* inserta una imagen en una hoja excel, posicionandola sobre la hoja/celda
'* indicadas, eliminando previamente uno ya existente del mismo nombre si se llega a pasar el nombre
'* Argumentos: strRutaImagen => ruta completa del archivo de imagen a insertar
'* strCelda => Celda en que posicionarla
'* strHoja => (opcional) hoja en que insertarla
'* intAnchomm => (opcional) ancho en milimetros (la altura sera proporcional a anchura)
'* strNombre => (opcional) nombre del gráfico
'* uso: InsertaImagen "C:\temp\prueba.png" , "E20",,100, "Grafico1"
'* Si utilizas este código, respeta la autoría y los créditos
'* ESH 17/10/08 18:36
'*******************************************************************************

Public Sub InsertaImagen(strRutaImagen As String, strCelda As String, Optional strHoja As String, Optional intAnchomm As Integer, Optional strNombre As String)
Dim strHojaActiva As String, _
Imagen As Object

Const Punto = 0.35278 ' 1 punto es equivalente a 0.35 mm

On Error GoTo InsertaImagen_TratamientoErrores

Application.ScreenUpdating = False

strHojaActiva = ActiveSheet.Name
' si no se ha pasado nombre de hoja, tomo la activa por defecto
If SiEsNulo(strHoja, "") = "" Then
strHoja = ActiveSheet.Name
Else
Worksheets(strHoja).Activate
End If
' elimino la imagen si es que existe
If Not SiEsNulo(strNombre, "") = "" Then
For Each Imagen In ActiveSheet.Pictures
If Imagen.Name = strNombre Then Imagen.Delete
Next Imagen
Else
strNombre = "Grafico"
End If

' inserto la imagen
ActiveSheet.Pictures.Insert(strRutaImagen).Name = strNombre ' <<<<<<<<<<
ActiveSheet.Pictures(strNombre).Select
' bloqueo la relación de aspecto
Selection.ShapeRange.LockAspectRatio = True
' si se ha pasado ancho lo aplico, sino, mantengo el original
If Not SiEsNulo(intAnchomm, 0) = 0 Then
Selection.ShapeRange.Width = intAnchomm / Punto
End If
' posiciono la imagen en la celda
With Worksheets(strHoja).Range(strCelda)
Selection.ShapeRange.Left = .Left
Selection.ShapeRange.Top = .Top
End With
' activo la hoja que estaba activa al iniciar el proceso
Worksheets(strHojaActiva).Activate

InsertaImagen_Salir:
Set Imagen = Nothing
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub

InsertaImagen_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: InsertaImagen de Módulo: Módulo1 (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume InsertaImagen_Salir
End Sub ' InsertaImagen

'***********************************************************************************
'* Emula la función Nz de Access, es decir devuelve el valor pasado como parámetro o
'* si se le pasa un argumento opcional, ese valor o en su defecto 0
'* Argumentos: vntValor => dato a comprobar
'* vntDevuelve => valor a devolver si el dato es nulo
'* uso: SiEsNulo(vntValor, True) devuelve True si vntValor es nulo o ""
'* SiEsNulo(vntValor) devuelve 0 si vntValor es nulo o ""
'* SiEsNulo(vntValor, "Null") devuelve Nulo si vntValor es nulo o ""
'* ESH 09/10/03 20:15
'* Si utilizas este código, respeta la autoría y los créditos
'*******************************************************************************

Public Function SiEsNulo(vntValor As Variant, Optional vntDevuelve As Variant) As Variant

If IsMissing(vntDevuelve) Then vntDevuelve = 0

If IsNull(vntValor) Or vntValor = "" Then
SiEsNulo = vntDevuelve
Else
SiEsNulo = vntValor
End If

End Function ' SiEsNulo

hola, Emilio !

1) hice unas pruebas con la siguiente propuesta de codigo obviamente mas
"corta" que la que expones (demasiadas variables)
y no ha dado ningun problema (version 2007), y no es necesario
"seleccionar" objetos para administrar sus propiadades
columna C: la ruta a las imagenes (png, tif, wmf, gif, etc.)
columna B la celda donde se "alineara" la imagen insertada
columna A el nombre asignado a la imagen

Sub Nueva_Imagen()
InsertaImagen [c1], [b1], [a1]
InsertaImagen [c2], [b2], [a2]
InsertaImagen [c3], [b3], [a3]
InsertaImagen [c4], [b4], [a4]
End Sub

Sub InsertaImagen(strRutaImagen As String, strCelda As String, strNombre
As String)
With ActiveSheet.Pictures.Insert(strRutaImagen)
.Name = strNombre
.ShapeRange.LockAspectRatio = True
.Left = Range(strCelda).Left
.Top = Range(strCelda).Top
End With
End Sub

2) no creo necesario "emular" funciones adicionales para comprobar si
algun argumento opcional se ha proveido
creo que es suficiente con la funcion integrada a vba de:
IsMissing(<argumento>)

3) tambien puedes evitar la necesidad anterior para la comprobacion, si
asignas algun valor "por omision" (p.e.)
Sub Procedimiento_X(strRutaImagen As String, Optional strNombre As
String = "Grafico", <etc. etc. etc.>

saludos,
hector.

__ OP __

hace unos días preparé el siguiente procedimiento que en excel 2003
funciona perfectamente
sin embargo en excel 2007 no, a pesar de que en algun momento lo ha hecho
y ningun cambio ha sido sustancial como para ello
el error es "No se puede obtener la propiedad Insert de la clase
Pictures." y se produce en la linea marcada con <<<<<<
es decir en el momento de insertar la imagen.

Le he dado mil vueltas pero ya no se por donde mas mirar, alguna idea?

Muchas gracias.

'*******************************************************************************
'* InsertaImagen
'* inserta una imagen en una hoja excel, posicionandola sobre la
hoja/celda
'* indicadas, eliminando previamente uno ya existente del mismo nombre si
se llega a pasar el nombre
'* Argumentos: strRutaImagen => ruta completa del archivo de imagen a
insertar
'* strCelda => Celda en que posicionarla
'* strHoja => (opcional) hoja en que insertarla
'* intAnchomm => (opcional) ancho en milimetros (la altura
sera proporcional a anchura)
'* strNombre => (opcional) nombre del gráfico
'* uso: InsertaImagen "C:\temp\prueba.png" , "E20",,100, "Grafico1"
'* Si utilizas este código, respeta la autoría y los créditos
'* ESH 17/10/08 18:36
'*******************************************************************************

Public Sub InsertaImagen(strRutaImagen As String, strCelda As String,
Optional strHoja As String, Optional intAnchomm As Integer, Optional
strNombre As String)
Dim strHojaActiva As String, _
Imagen As Object

Const Punto = 0.35278 ' 1 punto es equivalente a 0.35 mm

On Error GoTo InsertaImagen_TratamientoErrores

Application.ScreenUpdating = False

strHojaActiva = ActiveSheet.Name
' si no se ha pasado nombre de hoja, tomo la activa por defecto
If SiEsNulo(strHoja, "") = "" Then
strHoja = ActiveSheet.Name
Else
Worksheets(strHoja).Activate
End If
' elimino la imagen si es que existe
If Not SiEsNulo(strNombre, "") = "" Then
For Each Imagen In ActiveSheet.Pictures
If Imagen.Name = strNombre Then Imagen.Delete
Next Imagen
Else
strNombre = "Grafico"
End If

' inserto la imagen
ActiveSheet.Pictures.Insert(strRutaImagen).Name = strNombre ' <<<<<<<<<<
ActiveSheet.Pictures(strNombre).Select
' bloqueo la relación de aspecto
Selection.ShapeRange.LockAspectRatio = True
' si se ha pasado ancho lo aplico, sino, mantengo el original
If Not SiEsNulo(intAnchomm, 0) = 0 Then
Selection.ShapeRange.Width = intAnchomm / Punto
End If
' posiciono la imagen en la celda
With Worksheets(strHoja).Range(strCelda)
Selection.ShapeRange.Left = .Left
Selection.ShapeRange.Top = .Top
End With
' activo la hoja que estaba activa al iniciar el proceso
Worksheets(strHojaActiva).Activate

InsertaImagen_Salir:
Set Imagen = Nothing
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub

InsertaImagen_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: InsertaImagen de Módulo: Módulo1 ("
& Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume InsertaImagen_Salir
End Sub ' InsertaImagen

'***********************************************************************************
'* Emula la función Nz de Access, es decir devuelve el valor pasado como
parámetro o
'* si se le pasa un argumento opcional, ese valor o en su defecto 0
'* Argumentos: vntValor => dato a comprobar
'* vntDevuelve => valor a devolver si el dato es nulo
'* uso: SiEsNulo(vntValor, True) devuelve True si vntValor es nulo o ""
'* SiEsNulo(vntValor) devuelve 0 si vntValor es nulo o ""
'* SiEsNulo(vntValor, "Null") devuelve Nulo si vntValor es nulo o ""
'* ESH 09/10/03 20:15
'* Si utilizas este código, respeta la autoría y los créditos
'*******************************************************************************

Public Function SiEsNulo(vntValor As Variant, Optional vntDevuelve As
Variant) As Variant

If IsMissing(vntDevuelve) Then vntDevuelve = 0

If IsNull(vntValor) Or vntValor = "" Then
SiEsNulo = vntDevuelve
Else
SiEsNulo = vntValor
End If

End Function ' SiEsNulo

... gracias... desgraciadamente el error se repite :-S
... dias atras durante un rato funciono, de hecho, hoy he probado solo con la instruccion insert y se produjo el mismo error
no se que haya podido ocurrir pero es como si se hubiera producido algun tipo de "desconfiguracion" de mi Excel...

hola, Emilio !

... gracias... desgraciadamente el error se repite :-S
... dias atras durante un rato funciono, de hecho, hoy he probado solo
con la instruccion insert y se produjo el mismo error
no se que haya podido ocurrir pero es como si se hubiera producido algun
tipo de "desconfiguracion" de mi Excel...

op1: comprueba desde el editor de vba si hubiera alguna referencia
"perdida" hacia alguna libreria de objetos
-> (menu) herramientas / referencias... (alguna que diga
FALTA:xxx o MISSING: xxx)

op2: si realmente es una desconfiguracion de excel...
- (hasta donde se) el "truquito" con el modificador /regserver no
funciona para la version 2007
- seria necesario correr una (re)instalacion desde el panel de
control de windows (agregar/quitar programas)
-> con la opcion de reparar -?-

confirmas si te funciona alguna ?
saludos,
hector.

Gracias Hector Miguel :-))

las pruebas las he hecho siempre sobre un archivo "limpio", al que por
tanto no falta ninguna referencia, en cuanto a la reparación de la
instalación, eso ya será mañana, aquí ya es hora de irse a la cama, mañana
pues te contaré, aunque pensandolo bien, las pruebas las he hecho sobre
dos máquinas diferentes con Vista (32/64) y office 2007, por lo que me
extrañaría que fuera eso :S

Gracias de nuevo.

Saludos a desde Huelva

Emilio [MS-MVP Access 2006/8]
miliuco56 ALGARROBA hotmail.com
http://www.mvp-access.com/foro
http://www.mvp-access.es/emilio
"Héctor Miguel" escribió en el mensaje de
noticias news:

hola, Emilio !

... gracias... desgraciadamente el error se repite :-S
... dias atras durante un rato funciono, de hecho, hoy he probado solo
con la instruccion insert y se produjo el mismo error
no se que haya podido ocurrir pero es como si se hubiera producido algun
tipo de "desconfiguracion" de mi Excel...

op1: comprueba desde el editor de vba si hubiera alguna referencia
"perdida" hacia alguna libreria de objetos
-> (menu) herramientas / referencias... (alguna que diga
FALTA:xxx o MISSING: xxx)

op2: si realmente es una desconfiguracion de excel...
- (hasta donde se) el "truquito" con el modificador /regserver no
funciona para la version 2007
- seria necesario correr una (re)instalacion desde el panel de
control de windows (agregar/quitar programas)
-> con la opcion de reparar -?-

confirmas si te funciona alguna ?
saludos,
hector.