Falla en macro de insertar imagen
Sub CenterPicture()
Application.ScreenUpdating = False
Dim imag As Object
Dim celda As Range
Dim path As Variant
Dim fila As Integer
fila = 5
While Sheets("hoja2").Cells(fila, 5) <> Empty
path = Application.GetOpenFilename("archivos JPG PNG BMP (*.jpg*;*.png*;*.bmp*), *.jpg*;*.png*;*.bmp*")
Cells(fila, 5).Activate
Set ran = ActiveCell
Set imag = Sheets("hoja2").Pictures.Insert(path)
cv = 70
rh = 150
With imag
.Top = ran.Top
.Width = cv
.Height = rh
.Left = ran.Left
End With
ActiveCell.RowHeight = imag.Height
ActiveCell.ColumnWidth = 39.5
fila = fila + 1
Wend
Set imag = Nothing
Set ran = Nothing
End Sub
Me dice error 9 en tiempo de ejecucion
1 Respuesta
El error 9 puede deberse a varios motivos:
- Error en el nombre de algún libro
- Error en el nombre de alguna hoja
- Error en el nombre de algún objeto, o referencia de celda
La acabo de probar y funciona perfecto, quizás debas revisar entonces que tu libro tenga una hoja llamada 'hoja2', que haya datos en col E a partir de fila 5.
Solo faltaría contemplar la posibilidad de que canceles una ventana y te permita continuar con el resto de celdas. Observa las 2 líneas que dejo marcadas:
While Sheets("hoja2").Cells(fila, 5) <> Empty
path = Application.GetOpenFilename("archivos JPG PNG BMP (*.jpg*;*.png*;*.bmp*), *.jpg*;*.png*;*.bmp*")
Cells(fila, 5).Activate
Set ran = ActiveCell
If path = False Then GoTo sigo 'EM: contempla posible error de ventana cancelada
Set imag = Sheets("hoja2").Pictures.Insert(path)
cv = 70
rh = 150
With imag
.Top = ran.Top
.Width = cv
.Height = rh
.Left = ran.Left
End With
ActiveCell.RowHeight = imag.Height
ActiveCell.ColumnWidth = 39.5
sigo: 'EM: para continuar con el resto de filas
fila = fila + 1
WendSdos y no olvides valorar las respuestas.
Una pregunta .. tu dices que la macro te corre bn .. y entonces que es lo que hace la macro .. (es para insertar imágenes o para consultar imágenes o cual es la función.?
Con esa macro se insertan imágenes en celdas de la col E de hoja2, en aquellas celdas que tengan información, no vacías.
La imagen se ubica en los extremos de la celda y ésta se dimensiona según la dimensión de la imagen.
Sdos!
disculpa pero que clase de informacion necesito tener en la columna 5 .. ya que no se a que se refiere porque se supone que mi celda de la columna 5 debe esar avcia para colcar la imagen .. me puedes dar un ejemplo con capturaed pantalla plz
Bien, ahí está tu falla: la macro recorre la col E a partir de fila 5 hasta encontrar una celda vacía... y allí mismo coloca la imagen.
Comprendo tu situación ya que utilizas un código no explicado... no podías saber lo que hace la siguiente instrucción:
While Sheets("hoja2").Cells(fila, 5) <> Empty
Dice que recorra la hoja2 'mientras' la celda fila, 5 no esté vacía.
Llenalas con cualquier dato y proba la macro.
Sdos!
te he enviado mi caso aver si me puedes ayudar.. estariamuy agrecido .. :D porfavor
Así queda ajustada la macro, que según tu libro colocará las imágenes que selecciones en hoja Existencias a partir de la fila 2 que es donde se ubican tus datos. Y en col G se ubica la ruta de las imágenes para poder mostrarlas en el UF.
Sub CenterPicture()
'ajustada x Elsamatilde
Application.ScreenUpdating = False
Dim imag As Object
Dim celda As Range
Dim path As Variant
Dim fila As Integer
'1er fila con datos en hoja Existencias
fila = 2
'declarar la hoja para trabajar la macro desde cualquier otra
Set hoe = Sheets("Existencias")
'se completa la col E de hoja Existencias, en filas donde haya datos en col A
While hoe.Cells(fila, 1) <> Empty
path = Application.GetOpenFilename("archivos JPG PNG BMP (*.jpg*;*.png*;*.bmp*), *.jpg*;*.png*;*.bmp*")
hoe.Cells(fila, 5).Activate
Set ran = ActiveCell
'EM: contempla posible error de ventana cancelada
If path = False Then GoTo sigo
Set imag = hoe.Pictures.Insert(path)
'guarda la ruta de la imagen
hoe.Cells(fila, 7) = path
'dimensiona la celda
cv = 70
rh = 150
With imag
.Top = ran.Top
.Width = cv
.Height = rh
.Left = ran.Left
End With
ActiveCell.RowHeight = imag.Height
ActiveCell.ColumnWidth = 39.5
sigo: 'EM: para continuar con el resto de filas
fila = fila + 1
Wend
Set imag = Nothing
Set ran = Nothing
End Sub
