Consulta también:
- Codigo para guardar desde VB
- Código postal chile 2023 - Guide
- Codigos para pokemon rojo fuego - Guide
- Código puk claro - Guide
- Codigo de inscripcion pes 6 - Foro de videojuegos
- Código ascii extendido - Guide
1 respuesta
Código extraido de Elguille.info, no olvides visitar mi blog: www.mundocodes.blogspot.com
#If Win32 Then
'Declaración para 32 bits
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
#Else
'Declaración para 16 bits
Declare Function SendMessage Lib "User" _
(ByVal hWnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Long
#End If
Public Sub gsImprimir(qControl As Control, Optional vLPT, Optional vDirecto)
'--------------------------------------------------------------
'Procedimiento genérico para imprimir (31/Ago/97)
'
'Entrada:
' qControl control a imprimir (TextBox, ListBox)
' vLPT Impresora de salida, sólo para impresión directa
' vDirecto Si se imprime directamente o se usa el controlador
'--------------------------------------------------------------
Const MAXLINEA = 136 'Número de caracteres máximos por línea
Dim nFicSal As Integer
Dim sLpt As String
Dim i As Long
Dim j As Integer
Dim k As Long
Dim sTmp As String
Dim sImpresora As String
Dim bDirecto As Boolean
Dim tPrinter As Printer
Dim L1&, L2&
Const EM_GETLINECOUNT = &HBA
Const EM_LINEINDEX = &HBB
Const EM_LINELENGTH = &HC1
Set tPrinter = Printer
'El port de impresora a usar
If IsMissing(vLPT) Then 'Si no se especifica,
sLpt = "LPT1:" 'usar LPT1:
Else
sLpt = CStr(vLPT)
End If
'Si se va a imprimir directamente en el puerto
'o se va a usar el controlador de Windows
If IsMissing(vDirecto) Then 'Si no se especifica,
bDirecto = False 'usar el controlador de Windows
Else
bDirecto = CBool(vDirecto)
End If
'Quitarle los dos puntos, si lo tiene,
'seguramente no es necesario, pero...
If Right$(sLpt, 1) = ":" Then
sLpt = Left$(sLpt, Len(sLpt) - 1)
End If
If TypeOf qControl Is ListBox Then
'Número de items en el listbox
k = qControl.ListCount
Else
'Número de líneas del TextBox
k = SendMessage(qControl.hWnd, EM_GETLINECOUNT, 0, 0&)
End If
If bDirecto Then
'Imprimir directamente...
j = 0
nFicSal = FreeFile
'Abrir el puerto de impresora para salida...
Open sLpt For Output As nFicSal
Print #nFicSal, Chr$(15); 'Letra pequeña
Else
'Usar controlador de Windows
tPrinter.Print ""
tPrinter.Print ""
End If
'Se imprimirá cada una de las líneas del listbox o del textbox
'-------------------------------------------------------------
'En este último caso no sería necesario,
'ya que se puede imprimir TODO de una vez, usando esto:
'Printer.Print qControl.Text 'usando el controlador
'Print #nFicSal, qControl.Text 'imprimiendo directamente
'-------------------------------------------------------------
For i = 0 To k - 1
DoEvents
If TypeOf qControl Is ListBox Then
If bDirecto Then
Print #nFicSal, Left$(qControl.List(i), MAXLINEA)
Else
tPrinter.Print Left$(qControl.List(i), MAXLINEA)
End If
Else
'Primer carácter de la línea actual
L1 = SendMessage(qControl.hWnd, EM_LINEINDEX, i, 0&) + 1
'Longitud de la línea actual
L2 = SendMessage(qControl.hWnd, EM_LINELENGTH, L1, 0&)
If L2 > MAXLINEA Then L2 = MAXLINEA
If bDirecto Then
Print #nFicSal, Mid$(qControl.Text, L1, L2)
j = j + 1
'cada 60 líneas en una página
If j = 60 Then
Print #nFicSal, Chr$(12);
j = 0
End If
Else
tPrinter.Print Mid$(qControl.Text, L1, L2)
End If
End If
Next
If bDirecto Then
'Restaurar el tamaño de la fuente a normal
Print #nFicSal, Chr$(18);
'Si j vale CERO, ya se imprimió un salto de página
'en caso contrario, echar la hoja fuera
If j Then
Print #nFicSal, Chr$(12);
End If
Close nFicSal
Else
tPrinter.EndDoc
End If
End Sub
#If Win32 Then
'Declaración para 32 bits
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
#Else
'Declaración para 16 bits
Declare Function SendMessage Lib "User" _
(ByVal hWnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Long
#End If
Public Sub gsImprimir(qControl As Control, Optional vLPT, Optional vDirecto)
'--------------------------------------------------------------
'Procedimiento genérico para imprimir (31/Ago/97)
'
'Entrada:
' qControl control a imprimir (TextBox, ListBox)
' vLPT Impresora de salida, sólo para impresión directa
' vDirecto Si se imprime directamente o se usa el controlador
'--------------------------------------------------------------
Const MAXLINEA = 136 'Número de caracteres máximos por línea
Dim nFicSal As Integer
Dim sLpt As String
Dim i As Long
Dim j As Integer
Dim k As Long
Dim sTmp As String
Dim sImpresora As String
Dim bDirecto As Boolean
Dim tPrinter As Printer
Dim L1&, L2&
Const EM_GETLINECOUNT = &HBA
Const EM_LINEINDEX = &HBB
Const EM_LINELENGTH = &HC1
Set tPrinter = Printer
'El port de impresora a usar
If IsMissing(vLPT) Then 'Si no se especifica,
sLpt = "LPT1:" 'usar LPT1:
Else
sLpt = CStr(vLPT)
End If
'Si se va a imprimir directamente en el puerto
'o se va a usar el controlador de Windows
If IsMissing(vDirecto) Then 'Si no se especifica,
bDirecto = False 'usar el controlador de Windows
Else
bDirecto = CBool(vDirecto)
End If
'Quitarle los dos puntos, si lo tiene,
'seguramente no es necesario, pero...
If Right$(sLpt, 1) = ":" Then
sLpt = Left$(sLpt, Len(sLpt) - 1)
End If
If TypeOf qControl Is ListBox Then
'Número de items en el listbox
k = qControl.ListCount
Else
'Número de líneas del TextBox
k = SendMessage(qControl.hWnd, EM_GETLINECOUNT, 0, 0&)
End If
If bDirecto Then
'Imprimir directamente...
j = 0
nFicSal = FreeFile
'Abrir el puerto de impresora para salida...
Open sLpt For Output As nFicSal
Print #nFicSal, Chr$(15); 'Letra pequeña
Else
'Usar controlador de Windows
tPrinter.Print ""
tPrinter.Print ""
End If
'Se imprimirá cada una de las líneas del listbox o del textbox
'-------------------------------------------------------------
'En este último caso no sería necesario,
'ya que se puede imprimir TODO de una vez, usando esto:
'Printer.Print qControl.Text 'usando el controlador
'Print #nFicSal, qControl.Text 'imprimiendo directamente
'-------------------------------------------------------------
For i = 0 To k - 1
DoEvents
If TypeOf qControl Is ListBox Then
If bDirecto Then
Print #nFicSal, Left$(qControl.List(i), MAXLINEA)
Else
tPrinter.Print Left$(qControl.List(i), MAXLINEA)
End If
Else
'Primer carácter de la línea actual
L1 = SendMessage(qControl.hWnd, EM_LINEINDEX, i, 0&) + 1
'Longitud de la línea actual
L2 = SendMessage(qControl.hWnd, EM_LINELENGTH, L1, 0&)
If L2 > MAXLINEA Then L2 = MAXLINEA
If bDirecto Then
Print #nFicSal, Mid$(qControl.Text, L1, L2)
j = j + 1
'cada 60 líneas en una página
If j = 60 Then
Print #nFicSal, Chr$(12);
j = 0
End If
Else
tPrinter.Print Mid$(qControl.Text, L1, L2)
End If
End If
Next
If bDirecto Then
'Restaurar el tamaño de la fuente a normal
Print #nFicSal, Chr$(18);
'Si j vale CERO, ya se imprimió un salto de página
'en caso contrario, echar la hoja fuera
If j Then
Print #nFicSal, Chr$(12);
End If
Close nFicSal
Else
tPrinter.EndDoc
End If
End Sub
22 mar 2015 a las 21:43
tengo un libro con varias hojas y, una de ellas (hoja de firmas o trabajo) es la que yo quiero que me guarde en otra carpeta. Ya que dicha hoja especifica el trabajos de cada empleado cotidianamente.
No se si esto puede ser. Me gustaría si puedes se una ayuda en este tema que es parecido al código anterior.
un slu2.