Aparte, es el idioma universal.. no?
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes Menú
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