Jump to content

Macro vba excel para agregar imagen a los ajustes de impresión


Recommended Posts

Hola a todos;

-Estoy intentando añadir una imagen a los ajustes de impresión y no la carga. No sé donde puede estar el error.

Y una duda, ¿como puedo insertar una línea a lo ancho de la hoja?. Lo que tengo ahora mismo solo la inserta a la derecha, podría hacer lo mismo con left y center pero me deja un espacio en blanco y la línea no queda continua.

Private Sub btn_Imprimir_Click(): On Error Resume Next
With ActiveSheet.PageSetup
   .PrintArea = ActiveSheet.UsedRange.Address
   If IsNumeric(Me.TextBox1) Then
      .Zoom = CDbl(TextBox1)
      .CenterHeaderPicture.Filename = "C:\Users\Via Norte\Pictures\1.jpg"
      .RightFooter = "__________________________" & Chr(10) & "&P de &N"
   Else
      .Zoom = False
      .FitToPagesWide = 1
      .FitToPagesTall = 1
      .CenterHeaderPicture.Filename = "C:\Users\Via Norte\Pictures\1.jpg"
      .RightFooter = "__________________________" & Chr(10) & "&P de &N"
   End If
End With
Me.Hide
ActiveSheet.PrintPreview
Me.Show
End Sub

Adjunto macro e imagen.

saludos

Consulta.zip

Link to post
Share on other sites

Hola de nuevo Antoni;

Ahora en principio va, te adjunto la macro si quieres revisar por las dudas.

Lo que sigo sin saber como se hace es lo de la línea continua al pie.

Saludos e boa tarde.

Private Sub btn_Imprimir_Click() ': On Error Resume Next

With ActiveSheet.PageSetup
   .PrintArea = ActiveSheet.UsedRange.Address
   If IsNumeric(Me.TextBox1) Then
      .Zoom = CDbl(TextBox1)
      .LeftHeader = "&G" '<<<< faltaba esto
      .CenterHeaderPicture.Filename = "C:\Users\Via Norte\Pictures\1.jpg"
      .RightFooter = "__________________________" & Chr(10) & "&P de &N"
   Else
      .Zoom = False
      .FitToPagesWide = 1
      .FitToPagesTall = 1
      .LeftHeader = "&G" '<<<< faltaba esto
      .CenterHeaderPicture.Filename = "C:\Users\Via Norte\Pictures\1.jpg"
      .RightFooter = "__________________________" & Chr(10) & "&P de &N"
   End If

End With

Me.Hide
ActiveSheet.PrintPreview
ActiveSheet.PageSetup.LeftHeader = "" '<<<< Esto lo pongo para que elimine la imagen que carga en el encabezado
ActiveSheet.PageSetup.RightFooter = "" '<<<< Esto elimina el pie cargado
Me.Show
End Sub

 

MImprimir2.xlsm

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now


  • Crear macros Excel

  • Posts

    • Buenas tardes Haplox, es justo lo que necesitaba, funciona perfecto. Muchas gracias. Solucionado.
    • Hola a todos, Espero poder explicarme bien. Adjunto archivo y a continuación la explicación. Tengo una gran base de datos de la cual necesito pasar los datos de 2 columnas no contiguas a filas mientras éstos tengan el mismo ID. En el ejemplo, a partir de la columna L (marcado en rojo) pongo intercalado los valores de la columna K y D en la misma fila mientras el ID_FORMULA (columna A) sea igual y siempre en la primera fila del grupo (por grupo me refiero a igual valor en columna A). Aclaro que la cantidad de filas por ID no es fija. Ejemplo.xlsxPuede ser desde 2 filas hasta 7.  En el ejemplo, hay de 3, 5 y 4 filas.  Como son 900.000 filas se me ocurre que lo mejor es hacer un macro pero no sé como o tal vez haya otra forma sin macros.  Agradezco la ayuda. 
    • Yo pienso que si, y desde luego me apoyo en lo que he entendido, pero tu debes estar mas claro, sobre lo que necesitas ¡Suerte!   Saludos
    • Te dejo una solución según lo que explicas. Saludos Copia de Ejemplo.xlsm
    • José Lamento te hayas confundido con el (mal) ejemplo que puse en codigo,,,Cubo es una hoja por cierto y estoy copiando a otra, cuyo nombre está en la variable cractual, colu es un numero de columna al igual que columnacr, pero ---olvida ello y dale una mirada al adjunto por favor ...alli está lo que quiero hacer
  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy