Colocar imagen en varias Hojas
Tengo el siguiente código que permite seleccionar, redimensionar y colocar una imagen en una celda y hoja pero necesito que lo haga en varias hojas a la vez (FACTURA, NOTA, PRESUPUESTO, INFORME, GUIA MOVILIZACION), agradezco todo el apoyo que puedan prestarme.
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
ActiveSheet.Unprotect "123"
Sheets("FACTURA").Select
fichero = Application.GetOpenFilename
If fichero = False Then Exit Sub
ActiveSheet.Unprotect "123"
tope = Range("A1").Top
izq = Range("A1").Left
alto = Range("A1").Height
ancho = Range("A1").Width
ActiveSheet.Pictures.Insert(fichero).Select
w = Selection.Width
H = Selection.Height
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
ElseIf CheckBox1.Value = False Then
Call LIMPIARCHECKBOX
End If
ActiveSheet.Protect "123"
End Sub
1 respuesta
Este es un Modulo para limpiar los Checkbox y la imagen debe colocarse en la Celda A1
Sub LIMPIARCHECKBOX()
Dim c As Object
For Each c In ActiveSheet.OLEObjects
If InStr(1, c.Name, "CheckBox") > 0 Then
c.Object.Value = False
End If
Next
End Sub
Estos son los nombre de las otras hojas: "Proveedores", "Clientes", "Compras", "Ventas", "Devoluciones", "Inventario", "Tablas", "Dashboar", "Usuarios", "Datos" son 10 (diez) y estos son los nombres donde debe aparecer la imagen: "Factura", "Nota", "Presupuesto", "informe", "Guia" son 5 (cinco), te agradezco la ayudas que puedas prestarme. Nota: Todos los nombre de las Hojas son en Mayúsculas.
[Hola nuevamente
Como para que te des idea, y suponiendo que la imagen de cada hoja es distinta y la vas a elegir:
Dim Hoja As Worksheet
Dim fichero As Variant
Dim Imagen As Object
For Each Hoja In Worksheets
If Hoja.Name = "Factura" Or Hoja.Name = "Nota" Or Hoja.Name = "Presupuesto" _
Or Hoja.Name = "Informe" Or Hoja.Name = "Guia" Then
Hoja.Unprotect "123"
fichero = Application.GetOpenFilename
If fichero = False Then Exit Sub
Set Imagen = Hoja.Pictures.Insert(fichero)
With Imagen
.Top = Hoja.Range("A1").Top
.Left = Hoja.Range("A1").Left
.Height = Hoja.Range("A1").Height
.Width = Hoja.Range("A1").Width
End With
Hoja.Protect "123"
End If
Next HojaComentas
Abraham Valencia
Muchísimas gracias amigo Abraham excelente el código
Lo resolví de esta manera para que seleccione una imagen y la coloque en las cuatro hojas a la vez.
Private Sub CheckBox1_Click()
Dim Hoja As Worksheet
Dim fichero As Variant
Dim Imagen As Object
fichero = Application.GetOpenFilename
For Each Hoja In Worksheets
Select Case Hoja.Name
Case "FACTURA", "PRESUPUESTO", "GUIA", "NOTA"
ActiveSheet.Unprotect "123"
If fichero = False Then Exit Sub
Set Imagen = Hoja.Pictures.Insert(fichero)
With Imagen
.Top = Hoja.Range("A1").Top
.Left = Hoja.Range("A1").Left
.Height = Hoja.Range("A1").Height
.Width = Hoja.Range("A1").Width
End With
Call QUITARSELC
End Select
Next
ActiveSheet.Protect "123"
End Sub
Muy bien, solo sugiero cambiar "Activesheet" por "hoja".
Saludos]
Abraham Valencia
