Hilton
Experimente esses códigos para enviar os dados para a porta com
Módulo (basPrintPort)
- Código:
Type aht_tagDeviceRec
drDeviceName As String
drDriverName As String
drPort As String
End Type
Function PrintPort()
On Error GoTo Err_imprimir_Click
Dim dr As aht_tagDeviceRec
If ahtGetDefaultPrinter(dr) Then
PrintPort = dr.drPort
End If
Exit_Imprimir_Click:
Exit Function
Err_imprimir_Click:
If Err.Number = 76 Or Err.Number = 53 Then
MsgBox "Atenção!@Impressora desligada ou desconectada!@", vbExclamation
Else
MsgBox Err.Number & " - " & Err.Description, vbCritical
End If
Resume Exit_Imprimir_Click
End Function
Function ahtGetDefaultPrinter(dr As aht_tagDeviceRec) As Boolean
Dim strBuffer As String
strBuffer = ahtGetINIString("Windows", "Device")
If Len(strBuffer) > 0 Then
With dr
.drDeviceName = ahtGetToken(strBuffer, ",", 1)
.drDriverName = ahtGetToken(strBuffer, ",", 2)
.drPort = ahtGetToken(strBuffer, ",", 3)
End With
ahtGetDefaultPrinter = True
Else
ahtGetDefaultPrinter = False
End If
End Function
Módulo (basINIFile)
- Código:
Option Compare Database
Option Explicit
Const MAX_SIZE = 255
Const MAX_SECTION = 2048
Declare Function aht_apiGetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileInt" (ByVal strAppName As String, ByVal strKeyName As String, ByVal intDefault As Integer, ByVal strFileName As String) As Integer
Declare Function aht_apiGetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strDefault As String, ByVal strReturned As String, ByVal lngSize As Long, ByVal strFileName As String) As Long
Declare Function aht_apiGetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strDefault As String, ByVal strReturned As String, ByVal lngSize As Long) As Long
Declare Function aht_apiGetProfileInt Lib "kernel32" Alias "GetProfileInt" (ByVal strAppName As String, ByVal strKeyName As String, ByVal intDefault As Integer) As Integer
Declare Function aht_apiGetProfileSection Lib "kernel32" Alias "GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Declare Function aht_apiGetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFilename As String) As Long
Declare Function aht_apiWritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strValue As String, ByVal strFileName As String) As Integer
Declare Function aht_apiWriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strValue As String) As Integer
Function ahtGetINIInt(ByVal strGroup As String, ByVal strItem As String) As Variant
ahtGetINIInt = aht_apiGetProfileInt(strGroup, strItem, -1)
End Function
Function ahtGetINIString(ByVal strGroup As String, ByVal strItem As String) As Variant
Dim intChars As Integer
Dim strBuffer As String
strBuffer = String(MAX_SIZE, 0)
intChars = aht_apiGetProfileString(strGroup, strItem, "", strBuffer, MAX_SIZE)
ahtGetINIString = Left(strBuffer, intChars)
End Function
Function ahtGetPrivateINIInt(ByVal strGroup As String, ByVal strItem As String, ByVal strFile As String) As Variant
ahtGetPrivateINIInt = aht_apiGetPrivateProfileInt(strGroup, strItem, -1, strFile)
End Function
Function ahtGetPrivateIniString(ByVal strGroup As String, ByVal strItem As String, ByVal strFile As String) As Variant
Dim intChars As Integer
Dim strBuffer As String
strBuffer = String(MAX_SIZE, 0)
intChars = aht_apiGetPrivateProfileString(strGroup, strItem, "", strBuffer, MAX_SIZE, strFile)
ahtGetPrivateIniString = Left(strBuffer, intChars)
End Function
Function ahtGetProfileSection(ByVal strGroup As String) As Variant
Dim strBuffer As String
Dim intCount As Integer
strBuffer = Space(MAX_SECTION)
intCount = aht_apiGetProfileSection(strGroup, strBuffer, MAX_SECTION)
ahtGetProfileSection = Left(strBuffer, intCount)
End Function
Function ahtGetPrivateProfileSection(ByVal strGroup As String, ByVal strFile As String) As Variant
Dim strBuffer As String
Dim intCount As Integer
strBuffer = Space(MAX_SECTION)
intCount = aht_apiGetPrivateProfileSection(strGroup, strBuffer, MAX_SECTION, strFile)
ahtGetPrivateProfileSection = Left(strBuffer, intCount)
End Function
Módulo (basToken)
- Código:
Function ahtGetToken(ByVal strValue As String, ByVal strDelimiter As String, ByVal intPiece As Integer) As Variant
Dim intPos As Integer
Dim intLastPos As Integer
Dim intNewPos As Integer
On Error GoTo ahtGetTokenExit
strDelimiter = Left(strDelimiter, 1)
If (InStr(strValue, strDelimiter) = 0) Or (intPiece <= 0) Then
ahtGetToken = strValue
Else
intPos = 0
intLastPos = 0
Do While intPiece > 0
intLastPos = intPos
intNewPos = InStr(intPos + 1, strValue, strDelimiter)
If intNewPos > 0 Then
intPos = intNewPos
intPiece = intPiece - 1
Else
' Catch the last piece, where there's no
' trailing token.
intPos = Len(strValue) + 1
Exit Do
End If
Loop
If intPiece > 1 Then
ahtGetToken = Null
Else
ahtGetToken = Mid$(strValue, intLastPos + 1, intPos - intLastPos - 1)
End If
End If
ahtGetTokenExit:
Exit Function
ahtGetTokenErr:
MsgBox "Error in ahtGetToken: " & Error & " (" & Err & ")"
Resume ahtGetTokenExit
End Function
Use assim:
' perceba que é um botão de comando
Private Sub cmdTesteImp_Click()
Dim Impressão, ret As Double
NomeArquivo = FreeFile
' aqui vai gravar o relatorio em um arquivo texto
Open "C:\Pasta\Meurelatorio.txt" For Output As #NomeArquivo
Print #Impressão, Chr$(27) & Chr$(15) & Chr$(27) & Chr$(69); " TESTE DE IMPRESSÃO" & Chr$(27) & Chr$(70) & Chr$(20)
Print #Impressão, Chr$(27) & Chr$(15) & " R.Joao Pio Duarte Silva, 1124"
Print #Impressão, " Corrego Grande - Florianopolis"
Print #Impressão, " CNPJ: xxx.xxx.xxx/0001-35"
Close #Impressão
' impressão do relatório
ret = Shell("c:\Pasta\MeuRelatorio.bat", vbMinimizedFocus)
End Sub
Crie um arquivo batch (.bat) com o nome do teu relatório, por exemplo: MeuRelatorio.bat
dentro dele coloque:
Print c:\Pasta\MeuRelatorio.txt
====================
Eu usei essa código a muito tempo e agora não tenho impressora matricial para testar
Faça os testes e retorne, ok?
Nb
Última edição por Noobezinho em 15/10/2014, 23:40, editado 1 vez(es)
.................................................................................
A pergunta que não quer calar:Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
para enviar parte do projeto, não temos mais continuidade do tópico?
Crê que temos bolas de cristal ou está com medo que "roubemos" a
idéia/projeto dele? 
Se é tão bom assim...Ajude a ser ajudado:Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
sem precisar procurar o mesmo.
Início
![[Resolvido]imprimir cupom em negrito e aumentar o tamanho da fonte em impressora nao fiscal Empty](https://2img.net/i/empty.gif)
infformax 10/10/2014, 21:02
