Como insertar imágenes en otra hoja

Hola,
me ha surgido una duda que querría plantear:
Estoy creando una hoja de calculo y quiero que al pulsar un CheckBox, una imagen me aparezca en una hoja determinada y en un rango determinado. Lo que he conseguido es direccionarla a un rango concreto pero de la propia hoja. El código que he utilizado para direccionarla a la misma hoja es el siguiente:
Private Sub ckCasa10_Click() 
 Dim De_donde As String, Foto As Object, _
      Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
  Application.ScreenUpdating = False
  On Error Resume Next
  Me.Shapes("imgcasa").Delete 
  De_donde = "c:\esquemas\casa.jpg"
  If ckCasa10.Value = True Then 
    Set Foto = Me.Pictures.Insert(De_donde)
    With Activesheet.Range("c60:q65") 
      Arriba = .Top
      Izquierda = .Left
      Ancho = .Offset(0, .Columns.Count).Left - .Left
      Alto = .Offset(.Rows.Count, 0).Top - .Top
    End With
    With Foto
      .Name = "imgcasa"
      .Top = Arriba
      .Left = Izquierda
      .Width = Ancho
      .Height = Alto
    End With
    Set Foto = Nothing
  End If
End Sub
El Problema surge cuando quiero mandarla a el mismo rango pero de otra hoja. El código que utilizo es:
Private Sub ckCasa10_Click() 
 Dim De_donde As String, Foto As Object, _
      Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
  Application.ScreenUpdating = False
  On Error Resume Next
  Me.Shapes("imgcasa").Delete 
  De_donde = "c:\esquemas\casa.jpg"
  If ckCasa10.Value = True Then 
    Set Foto = Me.Pictures.Insert(De_donde)
    With WorkSheets("Hoja2").Range("c60:q65")

      Arriba = .Top
      Izquierda = .Left
      Ancho = .Offset(0, .Columns.Count).Left - .Left
      Alto = .Offset(.Rows.Count, 0).Top - .Top
    End With
    With Foto
      .Name = "imgcasa"
      .Top = Arriba
      .Left = Izquierda
      .Width = Ancho
      .Height = Alto
    End With
    Set Foto = Nothing
  End If
End Sub
Espero que haya sido claro,
Muchas Gracias!
Kilian Cuneo

1 respuesta

Respuesta
1
Bueno imtenta con lo siguiente:
Private Sub ckCasa10_Click()  
 Dim De_donde As String, Foto As Object, _ 
      Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double 
  Application.ScreenUpdating = False 
  On Error Resume Next 
  Me.Shapes("imgcasa").Delete  
  De_donde = "c:\esquemas\casa.jpg" 
  If ckCasa10.Value = True Then  
    Set Foto = Me.Pictures.Insert(De_donde) 
sheets("Hoja2").select
range("C60:C65").select
    With Range("C60:Q65") 
      Arriba = .Top 
      Izquierda = .Left 
      Ancho = .Offset(0, .Columns.Count).Left - .Left 
      Alto = .Offset(.Rows.Count, 0).Top - .Top 
    End With 
    With Foto 
      .Name = "imgcasa" 
      .Top = Arriba 
      .Left = Izquierda 
      .Width = Ancho 
      .Height = Alto 
    End With 
    Set Foto = Nothing 
  End If 
End Sub
Espero le sea de utilidad mi ayuda, recuerde que cualquier inquietud me la puede comunicar en mi perfil, si la respuesta le soluciono su problema NO OLVIDE PUNTUAR Y FINALIZAR LA PREGUNTA, de lo contrario no la finalice hasta que sea solucionada su consulta, que tenga un feliz día!
Hola,
Muchas gracias por la respuesta !
Esto es lo que buscaba, pero habría alguna otra manera para que al activar el check, no te activara la Hoja 2 y que al desactivarlo se borrara la imagen.
Con esto conseguiría que pudiese pulsar sobre varios checkbox sin tener que cambiar de hoja y además si me he equivocado al pulsar, que al desactivar el check, la imagen desapareciese.
Gracias otra vez
Ok, voy a trabajar en el desarrollo de la macro y cuando la tenga lista se la paso.
Bueno a continuación le dejo el código para que lo pruebe y me cuente como le fue
Private Sub ckCasa10_Click()
  Application.ScreenUpdating = False
 Dim De_donde As String, Foto As Object, _
      Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
If (ckCasa10.Value = True) Then
  On Error Resume Next
  Me.Shapes("imgcasa").Delete
  De_donde = "c:\esquemas\casa.jpg"
  If ckCasa10.Value = True Then
    Set Foto = Me.Pictures.Insert(De_donde)
Sheets("Hoja2").Select
Range("C60:C65").Select
    With Range("C60:Q65")
      Arriba = .Top
      Izquierda = .Left
      Ancho = .Offset(0, .Columns.Count).Left - .Left
      Alto = .Offset(.Rows.Count, 0).Top - .Top
    End With
    With Foto
      .Name = "imgcasa"
      .Top = Arriba
      .Left = Izquierda
      .Width = Ancho
      .Height = Alto
    End With
    Set Foto = Nothing
  End If
    Else
    If (ckCasa10.Value = False) Then
    Me.Shapes("imgcasa").Delete
End If
    Sheets("Hoja1").Select
 Application.ScreenUpdating = True
End Sub
Espero que sea lo que le necesita, si no le funciona la macro, le sugiero que envíe un modelo del archivo al correo [email protected] para analizarlo y corregir el error que se presente, de lo contrario si le funciona bien NO OLVIDE PUNTUAR Y FINALIZAR LA PREGUNTA que tenga un feliz día!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas