MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Dividir Texto (à Cima de 65mil Caracteres) em Caixas de Texto em Relatório com Até 64.000 Caracteres por Caixa e Texto

    Compartilhe
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3488
    Registrado : 14/08/2013

    Dividir Texto (à Cima de 65mil Caracteres) em Caixas de Texto em Relatório com Até 64.000 Caracteres por Caixa e Texto

    Mensagem  FabioPaes em Sab 05 Nov 2016, 00:33

    Sabemos que há um limite de 65.535 Caracteres por caixa de texto. ([Você precisa estar registrado e conectado para ver este link.])
    E eu desconheço como inserir mais que isso em uma única Caixa de Texto. Sua Função resulta em muitos Caracteres...  A solução encontrada então, é dividir Esse Valor (No exemplo postado é de 69.298) em frações de no máximo 65.535, para evitar perda de dados, recomendo 64.000.
     
    Outro agravante no Caso é que essa função constrói um relatório, linha a linha... E nem sempre no Caracteres de Nº 64.000 é o Fim de uma linha... Portanto teremos que saber dentro dessa sequência de Texto onde termina a Última Linha de registros, para não acontecer isso:
    [Você precisa estar registrado e conectado para ver esta imagem.]


    A Saída para isso foi utilizar a InStrRev para localizarmos o Último caractere da Última Linha de registros e extrairmos o Texto somente até esse Número de Caracteres.
    Dessa forma, Pegamos todo o Texto, dividimos ele em partes com no máximo 64.000.... Verificamos o final do último REGISTRO COMPLETO, colocamos na primeira Caixa de Texto.
    Na segunda Caixa de texto Extraímos mais 64.000 Caracteres porem iniciando do Número que paramos e colocamos na Caixa Texto 1 (A anterior). Repetimos isso até Acabar o Texto...
     
    Veja o Código Comentado para entender...

    Código:
    Private Sub Report_Load()
    '-------------------------------------------------------------------'
    '                                                                   '
    '                   Criado por FabioPaes                            '
    '             Em 04/11/2016 para o MaximoAccess                     '
    '          Livre para a utilização e aprendizado,                   '
    '                   preservando a autoria                           '
    '                                                                   '
    '-------------------------------------------------------------------'

    Dim TextoTotal As String ' Armazenará Todo o Texto
    Dim totCampos As Integer 'Calculará a quantidade de Campos necessarios no relatorio
    Dim valFinal As String   'Armazenará o Valor que sera impresso em cada campo
                            
                             'tCar (Conta quantos caracters tem em todo Texto;
                             'carFim (Armazenara o Numero do Caracter Final para Extração)
                             'carInicio (Armazenara o Numero do Caracter Inicial para Extração)
    Dim tCar, carFim, carInicio As Long
    Dim C As String          'Armazenara o Nome do Campo para ser usado no Loop

        'Passa Todo o texto para a Variavel
    TextoTotal = EstoqueInter()
        'Conta os Caracteres de todo Texto
    tCar = Len(TextoTotal)
        'Calcula a quantidade de Campos necessarios
    totCampos = ((tCar / 17000) + 0.99) \ 1

    If totCampos > 5 Then
    MsgBox "Atenção, o Relatorio gerou muitos Dados, por Informe o Administrador!", vbInformation
    Exit Sub
    Else
        'Inicia a extração do primeiro Caracter
    carInicio = 1
        'Inicio do LOOP que vai de 1 até a qnd de campos Necessarios para imprimir todo o Texto
    For i = 1 To totCampos
        C = "Txt" & i 'Controi o Nome do Campo que vai ser: txt+i (i=1,2,3,4...)
                'Extrai os primeiros 64mil caracters
        valFinal = Mid(TextoTotal, carInicio, 17000) 'Mude aqui para a Quantidade de Caracter que quer em cada Campo (preferencialmente 64000)
                'Localiza a posição Final da ultima linhas, para evitar linha quebrada (descrção em uma linha e valores em outra)
        carFim = InStrRev(valFinal, vbNewLine)
        
                'Extrai o Texto até a posição da ultima linha, e despresa o restante da linha que foi quebrada
        valFinal = Left(valFinal, carFim)
                'Aplica o Texto No Campo de acordo com a passagem do Loop (txt1, txt2,txt3...)
        Me.Controls(C) = valFinal
                'Armazena na variavel até que Caracter foi extraido do Texto, para pegar a partir dele no proximo LOOP
        carInicio = carInicio + Len(valFinal)
                'Limpa o ValorFinal para ser novamente construido no proximo LOOP
        valFinal = ""
    Next
    End If
    End Sub



     
    No exemplo está dividindo a cada 17.000 para teste, para utilizar 5 Caixa de Texto, mas no seu sistema mude para 64.000

    dropbox.com/s/47lsymad4sap23x/Dividir%20Texto%20em%20partes%20de%2065mil%20Caracters.rar?dl=0    - Copiar e colar no browser

    ------------------------------------------------------------------------------------------------------
    NOTA: Foi alterado o link externo, não são permitidos pelas Regras do Forúm.
    Deve-se remover    h t t p : / w w w .  ficando o resto.
    ------------------------------------------------------------------------------------------------------

    Tópico de Origem da Dúvida:
    [Você precisa estar registrado e conectado para ver este link.]
    Anexos
    Dividir Texto em partes de 65mil Caracters.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (290 Kb) Baixado 50 vez(es)


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!

      Data/hora atual: Qui 14 Dez 2017, 14:13