Mensajes

  lo quieres hacer en excel???

tomando la idea de Snort creo que se podría hacer asi:

Código [Seleccionar] Expandir


'Para enviar la imagen lo hago desde un command Button y la guardo en un archivo llamado "x.jpg"

Private Sub Command1_Click()
    Dim x As String, f As Long
    SavePicture Picture1.Picture, "c:\x.jpg"
   
    f = FreeFile
    Open "C:\x.jpg" For Binary Access Read As #f
    x = Space(LOF(f))
    Get #f, , x
    Close #f
   
    winsock1.SendData x
   
End Sub


'Para recibir lo hago con strdata y lo guardo en un archivo "x2.jpg" y luego cargo la imagen en el picture
Private Sub winsock2_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String, f As Long
   
    winsock2.GetData strData
    txtOutput.Text = txtOutput.Text & strData
       
    f = FreeFile
   
    Open "C:\x2.jpg" For Binary Access Write As #f
    Put #f, , txtOutput.Text
    Close #f
    On Local Error Resume Next
    Picture1.Picture = LoadPicture("c:\x2.jpg")
    On Local Error GoTo 0
   
End Sub


el error que dice que no reconoce el formato de la base de datos es ocasionado porque no tienes la referencia correcta al Microsoft DAO Objet Library, lo que debes hacer es agregar la referencia a la versión correcta, si usas una bd de access 97 debes poner la referencia a Microsoft DAO 2.5, para una de access 2000 debe ser la 3.51 y para access 2002 la 3.6

respecto a como acomodar columnas en un list he modificado el código anterior para acomodar 2 columnas.

en un módulo

Código [Seleccionar] Expandir


Option Explicit

Private Declare Function GetDialogBaseUnits Lib "user32.dll" () As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal HDC As Long, _
                                            ByVal hObject As Long) As Long

Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias _
                       "GetTextExtentPoint32A" (ByVal HDC As Long, ByVal _
                       lpString As String, ByVal cbString As Long, ByRef _
                       lpSize As SIZE) As Long
                       
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                       (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
                       wParam As Long, lParam As Any) As Long
   
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal _
                                                       HDC As Long) As Long

'Estructuras---------------------------------------------------------------------
Private Type SIZE
   cx As Long
   cy As Long
End Type

'Variables y constantes----------------------------------------------------------
Private tabs(10) As Long, texto1(10) As String, texto2(10) As String, tabs2(10) As Long, pos(10) As Integer
Private i As Integer, inf As Integer, sup As Integer
Private cantidad As Integer, cantidad2 As Integer
Private Const WM_GETFONT As Long = &H31&
Private Const LB_SETTABSTOPS As Long = &H192
Private Const Cadena = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
'*******************************************************************************'


Public Sub Centrar(LB As ListBox, Col1 As String, Col2 As String)
   
   Dim U As Single, resultado As Single, tamCol1 As Long, tamCol2 As Long, tamlist As Single
   Dim ParentForm As Form
     
   'Esta es la limitación que pongo: máximo 10 ítems..Si quieres utilizar más
   'de 10, deberás modificar el sencillo código. Ante alguna duda está mi
   'correo arriba.
   cantidad = LB.ListCount + 1
   If cantidad = 11 Then
       MsgBox "No puedes agregar más de 10 Ítems..." & vbCrLf & _
       "Deberás modificar antes algo de código." & vbCrLf & _
       "Es sencillo... :-)", vbInformation, "No se permite agregar más Ítems:"
       Exit Sub
   End If

   Set ParentForm = LB.Parent
   
   'El problema de los tabuladores es que hay que poner la distancia
   'en unidades de diálogo:
   U = UnidadporPixel(LB.hwnd)
   
   'Calcula el tamaño del texto:
   tamCol1 = Fix(calculatamaño(LB.hwnd, Col1) / U)
   tamCol2 = Fix(calculatamaño(LB.hwnd, Col2) / U)
   
   'Calcula el tamaño del ancho del listbox:
   tamlist = ParentForm.ScaleX(LB.Width, ParentForm.ScaleMode, vbPixels)
   tamlist = Fix((tamlist / U) - 1)
       
   'Calcula el tamaño del tabulador y lo guarda:
   resultado = (tamlist / 2) - tamCol1
   tabs(cantidad) = resultado
   
   'Guarda el texto en el array:
   texto1(cantidad) = Col1
   texto2(cantidad) = Col2
   'Borra todos los tabs y el listbox:
   LB.Clear
   Call SendMessage(LB.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   
   'La call ordenar() ordena los tabs de menor a mayor en tabs2(),
   'después dejará sólo un item repetido y por último calculará el
   'orden de tabulador a cada item.
   Call ordenar
   
   'Ahora introduzco de nuevo todos los elementos al listbox:
   For i = 1 To cantidad
       LB.AddItem (texto1(i) + vbTabs(pos(1)) + texto2(i))
       Call SendMessage(LB.hwnd, LB_SETTABSTOPS, cantidad2, tabs2(i))
   Next i
   
   Set ParentForm = Nothing
End Sub
'-------------------------------------------------------------------------------'
Private Function calculatamaño(ByVal hwnd As Long, texto2 As String) As Single
   'Esta función devuelve el tamaño del texto a centrar
   Dim hfuente As Long, Lfuente As Long, tamaño As SIZE
   Dim HDC As Long
   
   HDC = GetDC(hwnd)
   If HDC = 0 Then Exit Function
       
   hfuente = SendMessage(hwnd, WM_GETFONT, 0&, ByVal 0&)
   Lfuente = SelectObject(HDC, hfuente)
       
   If GetTextExtentPoint32(HDC, texto2, Len(texto2), tamaño) <> 0 Then
       calculatamaño = tamaño.cx 'Devuelve el tamaño
   End If
       
   Call SelectObject(HDC, Lfuente)
   Call ReleaseDC(hwnd, HDC)
   
End Function
'-------------------------------------------------------------------------------'

Private Function UnidadporPixel(ByVal hwnd As Long) As Single
   
   Dim DBU As Single, hfuente As Long, Lfuente As Long, tamaño As SIZE
   Dim Anchocaracter As Single
   Dim HDC As Long
   
   HDC = GetDC(hwnd) 'HDC  = Handle al Dispositivo de Contexto
                     'hwnd = listbox.hwnd
   
   If HDC = 0 Then Exit Function 'GetDC devuelve NULL si hay error
       
   'Recupera la fuente con la cual el control está dibujando el texto.
   hfuente = SendMessage(hwnd, WM_GETFONT, 0&, ByVal 0&)
   
   Lfuente = SelectObject(HDC, hfuente)
       
   'Calcula la anchura de la cadena de texto especificada.
   If GetTextExtentPoint32(HDC, Cadena, Len(Cadena), tamaño) <> 0 Then
       Anchocaracter = tamaño.cx / Len(Cadena) 'Promedio por carácter

       DBU = GetDialogBaseUnits And &HFFFF& 'Unidad de diálogo
       UnidadporPixel = (2 * Anchocaracter) / DBU
   End If
       
   Call SelectObject(HDC, Lfuente)
   Call ReleaseDC(hwnd, HDC) 'Tras GetDC hay que acabar con ReleaseDC para
                             'liberarlo
   
End Function
'-------------------------------------------------------------------------------'
Private Function vbTabs(num As Integer) As Variant
   'Número de tabuladores.
   Dim h As Integer
   vbTabs = ""
   For h = 1 To num
       vbTabs = vbTabs + vbTab
   Next h
End Function
'-------------------------------------------------------------------------------'
Private Sub ordenar()
   Dim po As Integer
   'Pasa todos los datos de tabs() a tabs2()
   For i = 1 To cantidad
       tabs2(i) = tabs(i)
   Next i
   
   'Los ordena de menor a mayor:
   inf = 1: sup = cantidad
   While inf < cantidad
   While sup >= inf + 1
       Call orden
   Wend
   inf = inf + 1: sup = cantidad
   Wend
   
   'Ahora hay que comprobar los repetidos y dejar sólo uno:
   cantidad2 = cantidad
   Dim p As Integer
   For i = 1 To cantidad2 - 1
       If i >= cantidad2 Then Exit For '<--Parece q esto no es necesario
       If tabs2(i) = tabs2(i + 1) Then '   pero sí lo es..
           For p = i + 1 To cantidad2 - 1
               tabs2(p) = tabs2(p + 1)
           Next p
           tabs2(cantidad2) = 0: cantidad2 = cantidad2 - 1: i = i - 1
       End If
   Next i
   'Ejemplo hasta aquí:
   'Datos ordenados: 2,10,23,23,23
   'Ahora:           2,10,23
   'Es decir, ahora ya están los tabs y el número que hay que
   'poner en sendmessage, y ordenados de menor a mayor..
   
   'Ahora sólo queda averiguar cuales son los tabs que se repiten y cuándo:
   For i = 1 To cantidad
       For p = 1 To cantidad2
           If tabs(i) = tabs2(p) Then pos(i) = p
       Next p
   Next i

End Sub
'-------------------------------------------------------------------------------'
Private Sub orden()
   Dim temp As Integer
   For sup = sup To inf + 1 Step -1
       If tabs2(inf) > tabs2(sup) Then
           temp = tabs2(inf)
           tabs2(inf) = tabs2(sup)
           tabs2(sup) = temp
           Exit For
       End If
   Next sup
End Sub


y el en form

Código [Seleccionar] Expandir


Private Sub Form_Load()
    Show
    With List1
        .Height = 1680
        .Left = 1080
        .Top = 240
        .Width = 5640
        .FontName = "Arial"
        .FontSize = 12
    End With
    With Form1
        .Height = 2685
        .Width = 7950
    End With
       
    'Esta es la forma de 'additem' ítems:
    'Centrar (nombre del listbox, string a insertar):
    Call Centrar(List1, "Texto ", "en")
    Call Centrar(List1, "2", "columnas")
End Sub


el código viene para centrar los items de un list, pero si se fijan es solo cosa de medir a que distancia queremos el texto, asi para hacer columnas, solo tendremos que separar el texto en las columnas que se quieran


PD. perdón por postear 2 veces esque como que la página se bloqueo o no se que y solo pude poner un pedazo

para poner culumnas en un list o en un combo chequense este post

http://foro.elhacker.net/index.php/topic,143992.msg676691.html#msg676691

a bueno asi si:

Código [Seleccionar] Expandir


    With ListView1
        .ColumnHeaders.Add , , "Columna1"
        .ColumnHeaders.Add , , "Columna2"
        .View = lvwReport
    End With


insertar un encabezado de columna

si pero con que control quieres hacerlo

insertar columnas??? en donde?????
en un Combo
en un List
en un listview
en un MsFlexGrid
crear campos en una tabla de Access, SQL...

y si en la configuración de la impresora habilitas la opción de "Imprimir cuando la ultima hoja haya entrado en la cola"