http://www.vb-decompiler.org/

Private Sub Command1_Click()
Dim Pendientes As Worksheet
Dim Linea As String
Dim strAux As String
Dim retMat() As String
Dim streams() As String
Dim IStreams As Long
Dim capturando As Boolean
Dim I As Long
Dim J As Long
Dim RowActual As Long
Dim ColActual As Long
Dim bAcu As Boolean
Dim NombreCampo As String
Dim cmdLine As String

Linea = "Está por importar datos de un PDF." + vbCrLf
Linea = Linea + "Debe tener seleccionada la celda desde la cual se insertarán las nuevas celdas importadas." + vbCrLf
Linea = Linea + "(La celda inical debe estar, preferentemente, al final de todas las anteriores)" + vbCrLf
Linea = Linea + "¿ Ha seleccionado esta celda inicial ?"
ret = MsgBox(Linea, vbQuestion + vbYesNo + vbDefaultButton1, "Atención")
If ret <> vbYes Then Exit Sub

cmdLine = Application.GetOpenFileName("Archivos PDF (*.pdf),*.pdf", 1, "Abrir PDF", , False)
If Dir(cmdLine) = "" Then Exit Sub

Set Pendientes = Worksheets("PENDIENTES2")
'Abre PDF para leer por lineas
Open cmdLine For Input Access Read As #1
IStreams = 0
capturando = False
Do While Not EOF(1)
    Line Input #1, Linea
    Linea = Trim(Linea)
    If Linea <> "" Then
        Select Case True
            Case UCase(Linea) = "STREAM"
                'comienza a capturar datos
                ReDim Preserve streams(IStreams)
                Line Input #1, Linea
                Linea = Trim(Linea)
                capturando = True
            Case UCase(Linea) = "ENDSTREAM"
                'termina de capturar stream
                IStreams = IStreams + 1
                capturando = False
        End Select
        If capturando Then
            streams(IStreams) = streams(IStreams) + Linea
        End If
    End If
Loop
Close #1

'el array streams ya contiene las lineas de informacion del PDF.
'Cada caracter de cada linea, estan en exresado en Hexa. Se utiliza la función Hexa2Ansi para convertirlas en ASCII.

'activar para insertar en 2 filas
RowActual = ActiveCell.Row - 2
'RowActual = ActiveCell.Row - 1
'ColActual = 1
For I = 0 To IStreams - 1
    Linea = Replace(streams(I), Chr(13), "")
    Linea = Replace(Linea, Chr(10), "")
    If parseTexto(Linea, retMat) > 0 Then
        'con parseTexto partimos la linea
        J = 0
        Do While J <= UBound(retMat)
            strAux = Hexa2Ansi(retMat(J))
            'Hexa2Ansi convierte cadena Hexa en ANSI
            If strAux <> "" Then
                strAux = Trim(strAux)
                If EsNuevoPedido(strAux) Then
                    'activar para insertar en 2 filas
                    RowActual = RowActual + 2
                    'RowActual = RowActual + 1
                End If
                bAcu = (strAux = "N° Orden:") Or (strAux = "Fecha Orden:") Or (strAux = "N° Cliente:")
                bAcu = bAcu Or (strAux = "Nom./Razón Soc.:") Or (strAux = "Nombre Fantasía:") Or (strAux = "Localidad:") Or (strAux = "Calle:")
                bAcu = bAcu Or (strAux = "N°:") Or (strAux = "Teléfono:") Or (strAux = "Horario de Visita:") Or (strAux = "Referencia de Domicilio:")
                bAcu = bAcu Or (strAux = "Marca y Modelo:") Or (strAux = "N° AF:") Or (strAux = "Síntoma:") Or (strAux = "Prioridad:") Or (strAux = "Reclamo:")
                bAcu = bAcu Or (strAux = "Descripción del Problema:")
                If bAcu Then
                    NombreCampo = strAux
                    J = J + 1
                    strAux = Hexa2Ansi(retMat(J))
                    If EsCampo(strAux) Or EsTitulo(strAux) Then
                        'es el siguiente campo, hay que rajar
                        GoTo FinLoop
                    Else
                        'MsgBox NombreCampo
                        'activar para insertar en 2 filas
                        ret = GetColPos(NombreCampo, ColActual)
                        'ret = GetColPos2(NombreCampo, ColActual)
                        If (ColActual = 5) And (ret = 0) Then
                            'columna de dirección (calle + alura)
                            Pendientes.Cells(RowActual, ColActual).Value = Pendientes.Cells(RowActual, ColActual).Value + " " + Trim(strAux)
                        ElseIf (ColActual = 2) And (ret = 0) Then
                            'columna de fecha
                            strAux = Replace(strAux, ".", "/")
                            strAux = Day(CDate(strAux)) & "-" & Month(CDate(strAux))
                            Pendientes.Cells(RowActual, ColActual).Value = strAux
                        ElseIf (ColActual = 3) And (ret = 0) Then
                            'numero de cliente
                            If Mid(strAux, 1, 2) = "0E" Then
                                Pendientes.Cells(RowActual, ColActual).Value = CLng(" " + Mid(strAux, 3, 10))
                            Else
                                Pendientes.Cells(RowActual, ColActual).Value = strAux
                            End If
                        ElseIf (ColActual = 9) And (ret = 0) Then
                            'Nº AF
                            If IsNumeric(strAux) Then
                                Pendientes.Cells(RowActual, ColActual).Value = CLng(strAux)
                            Else
                                Pendientes.Cells(RowActual, ColActual).Value = strAux
                            End If
                        ElseIf (ColActual = 1) And (ret = 0) Then
                            'Nº Orden
                            If IsNumeric(strAux) Then
                                Pendientes.Cells(RowActual, ColActual).Value = CLng(strAux)
                            Else
                                Pendientes.Cells(RowActual, ColActual).Value = strAux
                            End If
                        Else
                            'esta parte inserta en 2 filas
                            strAux = AcortarValor(UCase(Trim(strAux)))
                            If ret = 0 Then
                                Pendientes.Cells(RowActual, ColActual).Value = Trim(strAux)
                            Else
                                Pendientes.Cells(RowActual + 1, ColActual).Value = Trim(strAux)
                            End If
                            'strAux = AcortarValor(UCase(Trim(strAux)))
                            'Pendientes.Cells(RowActual, ColActual).Value = strAux
                        End If
                    End If
                End If
            Else
                MsgBox "Error en Hexa2Ansi"
                GoTo Salida
            End If
            J = J + 1
FinLoop:
        Loop
    End If
Next I
Salida:
'MsgBox "Datos cargados"
End Sub

Function AcortarValor(cadena As String) As String
Select Case Trim(cadena)
    Case "GAFA EXHIBIDORA VERT/VC / VISICOOLER"
        AcortarValor = "GAFA"
    Case "VESTFROST EXHIBIDORA/VC / VISICOOLER"
        AcortarValor = "VESTFROST"
    Case "GAFA EXHIBIDORA VERT/MV / MINI VISU"
        AcortarValor = "MV GAFA"
    Case "MINIVISU EXHIBIDORA /MV / MINI VISU"
        AcortarValor = "MV GAFA"
    Case "BEVERAGE AIR EXHIB. /VC / VISICOOLER"
        AcortarValor = "CONTOUR"
    Case "GAFA EXHIBIDORA DOBL/VD / VISICOOLER DOBL"
        AcortarValor = "GAFA 2P"
    Case "TRENTO EXHIBIDORA VE/VC / VISICOOLER"
        AcortarValor = "TRENTO"
    Case "EQUIPO GENÉRICO SIN /"
        AcortarValor = "GENERICO"
    Case "EXHIBIDORA VERTICAL /VC / VISICOOLER"
        AcortarValor = "TIPO VC"
    Case "SANTO TOME"
        AcortarValor = "STO. TOME"
    Case "SAUCE VIEJO"
        AcortarValor = "S. VIEJO"
    'Case "URGENTE"
    '    AcortarValor = "U"
    'Case "NORMAL"
    '    AcortarValor = "N"
    Case Else
        AcortarValor = cadena
End Select
End Function

Function GetColPos(Campo As String, ByRef Colu As Long) As Integer
Select Case Campo
    Case "N° Orden:"
        Colu = 1
        GetColPos = 0
    Case "Fecha Orden:"
        Colu = 2
        GetColPos = 0
    Case "N° Cliente:"
        Colu = 3
        GetColPos = 0
    Case "Nom./Razón Soc.:"
        Colu = 4
        GetColPos = 0
    Case "Nombre Fantasía:"
        Colu = 2
        GetColPos = 1
    Case "Localidad:"
        Colu = 7
        GetColPos = 0
    Case "Calle:"
        Colu = 5
        GetColPos = 0
    Case "N°:"
        Colu = 5
        GetColPos = 0
    Case "Teléfono:"
        Colu = 3
        GetColPos = 1
    Case "Horario de Visita:"
        Colu = 6
        GetColPos = 0
    Case "Referencia de Domicilio:"
        Colu = 4
        GetColPos = 1
    Case "Marca y Modelo:"
        Colu = 8
        GetColPos = 0
    Case "N° AF:"
        Colu = 9
        GetColPos = 0
    Case "Síntoma:"
        Colu = 10
        GetColPos = 0
    Case "Prioridad:"
        Colu = 5
        GetColPos = 1
    Case "Reclamo:"
        Colu = 6
        GetColPos = 1
    Case "Descripción del Problema:"
        Colu = 7
        GetColPos = 1
End Select
End Function

Function GetColPos2(Campo As String, ByRef Colu As Long) As Integer
Select Case Campo
    Case "N° Orden:"
        Colu = 1
        GetColPos2 = 0
    Case "Fecha Orden:"
        Colu = 2
        GetColPos2 = 0
    Case "N° Cliente:"
        Colu = 3
        GetColPos2 = 0
    Case "Nom./Razón Soc.:"
        Colu = 4
        GetColPos2 = 0
    Case "Nombre Fantasía:"
        Colu = 11
        GetColPos2 = 1
    Case "Localidad:"
        Colu = 7
        GetColPos2 = 0
    Case "Calle:"
        Colu = 5
        GetColPos2 = 0
    Case "N°:"
        Colu = 5
        GetColPos2 = 0
    Case "Teléfono:"
        Colu = 12
        GetColPos2 = 1
    Case "Horario de Visita:"
        Colu = 6
        GetColPos2 = 0
    Case "Referencia de Domicilio:"
        Colu = 13
        GetColPos2 = 1
    Case "Marca y Modelo:"
        Colu = 8
        GetColPos2 = 0
    Case "N° AF:"
        Colu = 9
        GetColPos2 = 0
    Case "Síntoma:"
        Colu = 10
        GetColPos2 = 0
    Case "Prioridad:"
        Colu = 14
        GetColPos2 = 1
    Case "Reclamo:"
        Colu = 15
        GetColPos2 = 1
    Case "Descripción del Problema:"
        Colu = 16
        GetColPos2 = 1
End Select
End Function

Function Hexa2Ansi(cadena As String) As String
'Convierte una cedana Hexa en ASCII
Dim I As Long
Dim Hexa As String
Dim car As Byte
Dim retCad As String

If Len(cadena) Mod 2 <> 0 Then
    Hexa2Ansi = ""
Else
    retCad = ""
    For I = 1 To Len(cadena) Step 2
        Hexa = Mid(cadena, I, 2)
        retCad = retCad + Chr(CByte("&H" + Hexa))
    Next I
End If
Hexa2Ansi = retCad
End Function

Function parseTexto(cadena As String, mat() As String) As Long
'Divide una linea de texto (ver ejemplo) obteniendo una cadena Hexa contenida entre < y >
'Ejemplo: 542.75 Td <304536303136333833>Tj ET 0 g BT 141.75 542.75 Td <4E6F6D2E2F52617AF36E20536F632E3A>Tj ET 0 g BT 226.75 542.75 Td <41475549525245204D4152494120414C454A414E445241>Tj ET 0 g BT 453.55 542.75 Td <4E6F6D6272652046616E746173ED613A>Tj
Dim cadCopy As String
Dim Inicio As Long
Dim Fin As Long
Dim Maxi As Long


ReDim mat(0)
Maxi = -1
cadCopy = cadena
Do
    Inicio = InStr(1, cadCopy, "<") + 1
    Fin = InStr(1, cadCopy, ">")
    If Inicio > 1 Then
        Maxi = Maxi + 1
        ReDim Preserve mat(Maxi)
        mat(Maxi) = Mid(cadCopy, Inicio, (Fin - Inicio))
    End If
    cadCopy = Mid(cadCopy, Fin + 1, Len(cadCopy))
Loop Until Inicio = 1
parseTexto = Maxi
End Function

Function EsNuevoPedido(cadena As String) As Boolean
EsNuevoPedido = (cadena = "PEDIDO SERVICIO TECNICO EQUIPOS DE FRIO")
End Function

Function EsCampo(cadena As String) As Boolean
Dim bAcu As Boolean

bAcu = False
bAcu = bAcu Or (cadena = "N° Orden:")
bAcu = bAcu Or (cadena = "Fecha Orden:")
bAcu = bAcu Or (cadena = "Fecha Prev. Solución:")
bAcu = bAcu Or (cadena = "Técnico:")
bAcu = bAcu Or (cadena = "N° Cliente:")
bAcu = bAcu Or (cadena = "Nom./Razón Soc.:")
bAcu = bAcu Or (cadena = "Nombre Fantasía:")
bAcu = bAcu Or (cadena = "Contacto:")
bAcu = bAcu Or (cadena = "Provincia:")
bAcu = bAcu Or (cadena = "Localidad:")
bAcu = bAcu Or (cadena = "Barrio:")
bAcu = bAcu Or (cadena = "Calle:")
bAcu = bAcu Or (cadena = "N°:")
bAcu = bAcu Or (cadena = "Teléfono:")
bAcu = bAcu Or (cadena = "Horario de Visita:")
bAcu = bAcu Or (cadena = "Referencia de Domicilio:")
bAcu = bAcu Or (cadena = "Tipo:")
bAcu = bAcu Or (cadena = "Marca y Modelo:")
bAcu = bAcu Or (cadena = "N° AF:")
bAcu = bAcu Or (cadena = "N° E.C:")
bAcu = bAcu Or (cadena = "Observaciones:")
bAcu = bAcu Or (cadena = "Síntoma:")
bAcu = bAcu Or (cadena = "Prioridad:")
bAcu = bAcu Or (cadena = "Reclamo:")
bAcu = bAcu Or (cadena = "Descripción del Problema:")
bAcu = bAcu Or (cadena = "Fecha Visita:")
bAcu = bAcu Or (cadena = "N° A.F.:")
bAcu = bAcu Or (cadena = "Realizado Por:")
bAcu = bAcu Or (cadena = "Tipo Falla:")
bAcu = bAcu Or (cadena = "Descripción:")
EsCampo = bAcu
End Function

Function EsTitulo(cadena As String) As Boolean
Dim bAcu As Boolean

bAcu = False
bAcu = bAcu Or (cadena = "PEDIDO SERVICIO TECNICO EQUIPOS DE FRIO")
bAcu = bAcu Or (cadena = "Datos Orden")
bAcu = bAcu Or (cadena = "Datos Cliente")
bAcu = bAcu Or (cadena = "Datos Equipo")
bAcu = bAcu Or (cadena = "Datos Falla")
bAcu = bAcu Or (cadena = "Datos Última Visita")
EsTitulo = bAcu
End Function

Function Str2Campo(strCampo As String) As String
Select Case strCampo
    Case "N° Orden:"
        Str2Campo = "NumOrden"
    Case "Fecha Orden:"
        Str2Campo = "FechaOrden"
    Case "N° Cliente:"
        Str2Campo = "NumCliente"
    Case "Nom./Razón Soc.:"
        Str2Campo = "Nombre"
    Case "Nombre Fantasía:"
        Str2Campo = "Fantasia"
    Case "Localidad:"
        Str2Campo = "Localidad"
    Case "Calle:"
        Str2Campo = "Calle"
    Case "N°:"
        Str2Campo = "Altura"
    Case "Teléfono:"
        Str2Campo = "Telefono"
    Case "Horario de Visita:"
        Str2Campo = "HorarioVisita"
    Case "Referencia de Domicilio:"
        Str2Campo = "RefDomicilio"
    Case "Marca y Modelo:"
        Str2Campo = "MarcaYModelo"
    Case "N° AF:"
        Str2Campo = "NumAF"
    Case "Síntoma:"
        Str2Campo = "Sintoma"
    Case "Prioridad:"
        Str2Campo = "Prioridad"
    Case "Reclamo:"
        Str2Campo = "Reclamo"
    Case "Descripción del Problema:"
        Str2Campo = "DescribeProblema"
End Select
End Function