Selecc. Rango d celdas donde guardar imagen excel

Hola:
EStoy haciendo un formulario para una colección de monedas en excel, y la verdad es que no se casi nada de excel. El caso es que tengo un formulario ya hecho donde se busca una imagen en el disco duro con un botón, luego se muestra en un cuadro de imagen, y con otro botón se envía a una casilla de la hoja, que tiene que ir cambiando para cada imagen que meto. Muestro el codigo que tengo:
Private Sub SendPictureToRange_Click()
Dim r As Range
ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_HIDE
Set r = Application.InputBox("Select the range to insert your picture...", , , , , , , 8)
ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_SHOW
With ActiveSheet.Pictures.Insert(LastSelectedFilePath)
.Top = r.Top
.Left = r.Left
.Width = r.Width
.Height = r.Height
End With
Lo que no se es lo que tengo que poner donde la negrita. Ya os digo que lo que llevo hecho es que lo voy encontrando por la web, que no se mucho de excel.
A ver si alguien me puede ayudar. Un saludo y muchas gracias

1 respuesta

Respuesta
1
Te dejo una rutina completa para que tomes las instrucciones que te faltan. Debés reemplazar la línea del With por la tuya, ya que tomé una imagen ya establecida.
Sub imagen()
on error goto fin    'por si se cancela el InputBox
Set r = Application.InputBox("Ingrese un rango", Type:=8)
'si el rango no está vacío lo seleccionamos
If Not r Is Nothing Then
r.Select
'ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_SHOW
'With ActiveSheet.Pictures.Insert(LastSelectedFilePath)
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\cibersoft.jpg")
.Select
'se guarda la posición superior e izquierda de la celda y se asignan estos valores a la imagen
.Top = r.Top
.Left = r.Left
.Width = r.Width
.Height = r.Height
End With
End If
fin:
End Sub
Saludos y no olvides regresar para finalizar la consulta
Elsa
* Rutina extraída de mi manual 400MacrosPlus. Más ejercicios en:
http://es.geocities.com/lacibelesdepunilla/manuales
Aver, coloco todo el código que tengo:
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 5
Private LastSelectedFilePath As String
Private Sub BrowseForFile_Click()
Dim fileToOpen
fileToOpen = Application.GetOpenFilename("Picture Files (*.emf; *.wmf; *.jpg; *.jpeg; *.png; *.bmp; *.dib; *.gif; *.tif; *.tiff), *.emf; *.wmf; *.jpg; *.jpeg; *.png; *.bmp; *.dib; *.gif; *.tif; *.tiff")
If fileToOpen = False Then Exit Sub
Image1.PictureSizeMode = fmPictureSizeModeStretch
Set Image1.Picture = LoadPicture(fileToOpen)
LastSelectedFilePath = fileToOpen
End Sub
Private Sub SendPictureToRange_Click()
Dim r As Range
ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_HIDE
Set r = Application.InputBox("Select the range to insert your picture...", , , , , , , 8)
ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_SHOW
With ActiveSheet.Pictures.Insert(LastSelectedFilePath)
.Top = r.Top
.Left = r.Left
.Width = r.Width
.Height = r.Height
End With
End Sub
La primera parte, la de buscar la imagen y mostrarla en el cuadro de imagen funciona bien, pero lo que no sé es que le falta a la segunda parte que no envía la imagen a la hoja de excel. Algo le falta, pero no se que es. Ya digo que de programación en excel es lo primero que hago, por lo que me suena todo a chino.
Un saludo y muchas gracias.
Te la escribo completa, y si no te resulta podés pedirme el archivo de ejemplo al correo que encontrarás en mi sitio.
Si bien encontraste una rutina un poco complicada igualmente funciona.
Quizás no lo estás escribiendo en el lugar adecuado (todo dentro del Userform) o tu botón no se llama como lo estás indicando en la 2da rutina (verificalo).
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 5
Private LastSelectedFilePath As String
Private Sub BrowseForFile_Click()
Dim fileToOpen
fileToOpen = Application.GetOpenFilename("Picture Files (*.emf; *.wmf; *.jpg; *.jpeg; *.png; *.bmp; *.dib; *.gif; *.tif; *.tiff), *.emf; *.wmf; *.jpg; *.jpeg; *.png; *.bmp; *.dib; *.gif; *.tif; *.tiff")
If fileToOpen = False Then Exit Sub
Image1.PictureSizeMode = fmPictureSizeModeStretch
Set Image1.Picture = LoadPicture(fileToOpen)
LastSelectedFilePath = fileToOpen
End Sub
Private Sub SendPictureToRange_Click()
Dim r As Range
ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_HIDE
Set r = Application.InputBox("Select the range to insert your picture...", , , , , , , 8)
ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_SHOW
With ActiveSheet.Pictures.Insert(LastSelectedFilePath)
.Top = r.Top
.Left = r.Left
.Width = r.Width
.Height = r.Height
End With
¡¡MUCHAS GRACIAS!! Ha funcionado a la perfección. El problema estaba en el segundo botón, que tenia una letra cambiada y no me daba cuenta hasta que me lo dijiste y me fijé bien.
Muchisimas gracias, porque ya me estaba volviendo loco pensando que fallaba y no funcionaba.
Un saludo ;)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas