Crear un rectangulo tipo columnas con printer

[E N T E R]

Necesito hacer unos campos con el objeto printer

Ejemplo.

[YAcosta]

¿te refieres a que quieres exactamente esa imagen generada con el objeto printer o parecida?

[E N T E R]

Si se pudiera así seria buenísimo, o si no solo las lineas negras formarlo asi mismo.

[raul338]

El quiere fabricar cuadro por cuadro esa tabla

Tienes que hacer muchas cuentas, para que sea todo centrado, despues dibujar cuadrados y el texto. Ahora mismo no se me ocurre nada, pero quizás puedas hacerlo con HTML y despues "Imprimirlo" (creo que habia un codigo para eso, desde el control webbrowser)

[erbuson]

Hola, esto no es mas que una idea para montarlo. Creas de momento un Formulario con un Picture1 y un Command1

Código: (VB) [Seleccionar]

Private Sub Command1_Click()
  Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
  Dim altocabecera As Long, altodetalles As Long
  Dim Columna(5) As Long
  Dim Indice As Integer
  x1 = 100
  y1 = 100
  altocabecera = 500
  altodetalles = 5000
  Columna(0) = 800
  Columna(1) = 2000
  Columna(2) = 700
  Columna(3) = 3000
  Columna(4) = 800
  For Indice = 0 To UBound(Columna)
    x2 = x1 + Columna(Indice)
    y2 = y1 + altocabecera
    Picture1.Line (x1, y1)-(x2, y2), vbRed, BF
    Picture1.Line (x1, y1)-(x2, y2), vbBlack, B
    Picture1.Line (x1, y1 + altocabecera)-(x2, y1 + altocabecera + altodetalles), vbBlack, B
    x1 = x2
  Next
End Sub
Falta añadirle el centrado de los títulos pero esto no es muy complicado, después se utiliza Printer en lugar de Picture1 y listos

[E N T E R]

Bien ahí erbuson, mejor imposible jejej.

Muchas gracias.

[erbuson]

Aqui con el centrado de los títulos:

Código: (VB) [Seleccionar]

Private Sub Command1_Click()
  Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long, masx As Long, masy As Long
  Dim altocabecera As Long, altodetalles As Long
  Dim Columna(5) As Long, Titulo(5) As String
  Dim Indice As Integer
  x1 = 100
  y1 = 100
  altocabecera = 500
  altodetalles = 5000
  Columna(0) = 800:  Titulo(0) = "CODIGO"
  Columna(1) = 2000: Titulo(1) = "ARTICULOS"
  Columna(2) = 700:  Titulo(2) = "CANT."
  Columna(3) = 3000: Titulo(3) = "P.VENTA"
  Columna(4) = 800:  Titulo(4) = "EXENTA"
  Columna(5) = 1800: Titulo(5) = "IVA10"
  For Indice = 0 To UBound(Columna)
    x2 = x1 + Columna(Indice)
    y2 = y1 + altocabecera
    Picture1.Line (x1, y1)-(x2, y2), vbRed, BF
    Picture1.Line (x1, y1)-(x2, y2), vbBlack, B
    masx = (Columna(Indice) - Picture1.TextWidth(Titulo(Indice))) / 2
    masy = (altocabecera - Picture1.TextHeight(Titulo(Indice))) / 2
    Picture1.CurrentX = x1 + masx
    Picture1.CurrentY = y1 + masy
    Picture1.ForeColor = vbYellow
    Picture1.Print Titulo(Indice)
    Picture1.Line (x1, y1 + altocabecera)-(x2, y1 + altocabecera + altodetalles), vbBlack, B
    x1 = x2
  Next
End Sub
Saludos

[E N T E R]

Espectacular amigo, muchas gracias

Saludos...

[erbuson]

Como al final me han entrado las ganas de terminarlo y a la larga me puede resultar util. He creado el mismo en un módulo reutilizable.

Módulo:

Código: (VB) [Seleccionar]

Option Explicit

Type ValoresImpresion
  Hacia As Object              ' Objeto que recibe la información Picture o Printer asignar por Set
  Izquierda As Long            ' Posicion Izquierda (x)
  Arriba As Long               ' Posicion Arribe    (y)
  Columnas(99) As Long         ' Defino 100 columnas como máximo de 0 a 99
  Titulos(99) As String        ' Titulos de Cabeceras la ultima posición puede indicar el Ajuste en Detalle <, >, =
  NumeroColumnas As Integer    ' Para indicar el número de Columnas que utilizamos
  AjustesEnTitulos As Boolean  ' Indica si en los Titulos de Cabecera se ha indicado el tipo de Ajuste
  AltoCabecera As Long         ' Alto de la Columna de Cabecera
  AltoDetalles As Long         ' Alto del Bloque de Detalles
  ColorFondoCabecera As Long
  ColorTextoCabecera As Long
  ColorFondoDetalles As Long
  ColorTextoDetalles As Long
  ColorBordes As Long
  AnchoBordes As Integer
  MargenExtra As Integer       ' Margen para evitar que escriba pegado junto a las lineas
End Type

Public OpcionesImpresion As ValoresImpresion

Public Sub PintaFormato()
  Dim Izquierda As Long
  Dim Derecha As Long, Abajo As Long, AjusteHor As Long, AjusteVer As Long, Indice As Integer, Titulo As String
  With OpcionesImpresion
    Izquierda = .Izquierda
    If .AnchoBordes > 0 Then .Hacia.DrawWidth = .AnchoBordes
    For Indice = 0 To .NumeroColumnas
      Titulo = Trim$(.Titulos(Indice))
      If .AjustesEnTitulos Then Titulo = Trim$(Left$(Titulo, Len(Titulo) - 1))
      Derecha = Izquierda + .Columnas(Indice)
      Abajo = .Arriba + .AltoCabecera
      .Hacia.Line (Izquierda, .Arriba)-(Derecha, Abajo), .ColorFondoCabecera, BF
      .Hacia.Line (Izquierda, .Arriba)-(Derecha, Abajo), .ColorBordes, B
      AjusteHor = (.Columnas(Indice) - .Hacia.TextWidth(Titulo)) / 2
      AjusteVer = (.AltoCabecera - .Hacia.TextHeight(Titulo)) / 2
      .Hacia.CurrentX = Izquierda + AjusteHor
      .Hacia.CurrentY = .Arriba + AjusteVer
      .Hacia.ForeColor = .ColorTextoCabecera
      .Hacia.Print Titulo
      .Hacia.Line (Izquierda, .Arriba + .AltoCabecera)-(Derecha, .Arriba + .AltoCabecera + .AltoDetalles), .ColorFondoDetalles, BF
      .Hacia.Line (Izquierda, .Arriba + .AltoCabecera)-(Derecha, .Arriba + .AltoCabecera + .AltoDetalles), .ColorBordes, B
      Izquierda = Derecha
    Next
  End With
End Sub

Public Sub PintaCampo(Fila As Long, Columna As Long, Dato As String, Optional Ajuste As String)
  Dim Indice As Integer, Posicion As Long, Ancho As Long
  With OpcionesImpresion
    For Indice = 0 To Columna
      Posicion = Posicion + .Columnas(Indice)
    Next
    Ancho = .Hacia.TextWidth(Dato)
    If Ajuste = "" And .AjustesEnTitulos Then Ajuste = Right$(Trim$(.Titulos(Columna)), 1) Else Ajuste = "<"
    Select Case UCase(Ajuste)
      Case "<": Posicion = Posicion - .Columnas(Columna) + .MargenExtra
      Case ">": Posicion = Posicion - Ancho - .MargenExtra
      Case "=": Posicion = Posicion - .Columnas(Columna) / 2 - Ancho / 2
    End Select
    .Hacia.ForeColor = .ColorTextoDetalles
    .Hacia.CurrentX = Posicion + .Arriba
    .Hacia.CurrentY = .AltoCabecera + .Izquierda + (Fila - 1) * .Hacia.TextHeight(Dato) + .MargenExtra
    .Hacia.Print Dato
  End With
End Sub
Ejemplo de utilización, el formulario contiene un Picture y un Command.

Código: (VB) [Seleccionar]

Option Explicit

Private Sub Command_Click()
  Dim Fila As Long
  With OpcionesImpresion
    Set .Hacia = Picture
    .Izquierda = 100
    .Arriba = 100
    .Columnas(0) = 1100: .Titulos(0) = "CODIGO ="     ' Puede indicarse título asi "CODIGO="
    .Columnas(1) = 2200: .Titulos(1) = "ARTICULOS <"
    .Columnas(2) = 1400: .Titulos(2) = "CANT. >"
    .Columnas(3) = 3000: .Titulos(3) = "P.VENTA >"
    .Columnas(4) = 1800: .Titulos(4) = "EXENTA >"
    .Columnas(5) = 1800: .Titulos(5) = "IVA10 >"
    .NumeroColumnas = 5
    .AjustesEnTitulos = True
    .AltoCabecera = 500
    .AltoDetalles = 5000
    .ColorFondoCabecera = vbRed
    .ColorTextoCabecera = vbYellow
    .ColorFondoDetalles = vbWhite
    .ColorTextoDetalles = vbBlue
    .ColorBordes = vbBlack
    .AnchoBordes = 1
    .MargenExtra = 40
  End With
 
  PintaFormato
 
  For Fila = 1 To 10 Step 2
    PintaCampo Fila, 0, "CODIGO1"
    PintaCampo Fila, 1, "DESCRIPCION"
    PintaCampo Fila, 2, "1.250,32"
 
    PintaCampo Fila + 1, 0, "CODIGO2"
    PintaCampo Fila + 1, 1, "PRODUCTO"
    PintaCampo Fila + 1, 2, "125,14"
  Next
 
End Sub
Importante la asignación del Objeto que recibe las instrucciones  Set .Hacia = Picture o Set .Hacia = Printer

Creo que de la manera que esta, es facilmente mejorable ya que se pueden definir Letras, Tamaños, etc. con sólo añadir el campo al Type y después utilizarlo en los dos Subs

Saludos

[E N T E R]

Un espectáculo quedo amigo, gracias por compartir. a mi me gusta mas imprimir con el printer por eso estaba buscando algo así, es un trabajo un poco mas complicado que usar reportes pero una ves que centres en la factura ya queda ahi.

Saludos y muchas gracias...