Tengo algún problema con el siguiente código. Cada vez que ejecuto el código vba, el código CleanFileName y CleanUsedRange eliminan mis fórmulas de Vlook.
¿Hay alguna forma de utilizar CleanFileName y CleanUsedRange sin que se eliminen las fórmulas de vlook? los codigos estan debajo
Private Sub CommandButton1_Click()
Const FULL_PATH = "C:\Documents\test\quot.txt"
Dim fId As String, txt As String, txtLen As Long, d As Object, dc As Long
fId = FreeFile
Open FULL_PATH For Input As fId
txt = Input(LOF(fId), fId) 'Read entire file (not line-by-line)
Close fId
txtLen = Len(txt)
Set d = CreateObject("Scripting.Dictionary")
d("Name") = "C11" 'Same as: d.Add Key:="Name", Item:="C11"
d("Phone") = "H13"
d("Address1") = "C15"
d("Email") = "C13"
d("Postcode") = "H16"
d("SR") = "C10"
d("MTM") = "H14"
d("Serial") = "H15"
d("Problem") = "C17"
d("Action") = "C18"
d("Dated") = "H10"
dc = d.Count
Dim i As Long, k As String, sz As Long, found As Long
With ThisWorkbook.Worksheets("Sheet1") '<--- Update sheet name
For i = 0 To dc - 1 'd.Keys()(i) is a 0-based array
k = d.Keys()(i) 'Name, Phone, etc
found = InStr(txt, k) + Len(k) + 1 'Find the (first) key in file
If found > 0 Then 'Determine item length by finding the next key
If i < dc - 1 Then sz = InStr(txt, d.Keys()(i + 1)) Else sz = txtLen + 2
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
End If
Next
End With
End Sub
El archivo limpio
Public Function CleanFileName(ByVal fName As String) As String
Dim b() As Byte, specialChars As Variant, i As Long
b = "\/:*?|<>" & Chr(34) & Chr(8) & Chr(9) & Chr(10) & Chr(13)
specialChars = Split(StrConv(b, vbUnicode), Chr(0))
fName = Trim$(fName) 'Trim, then remove \ / : * ? | < > " Backspace Tab LF CR
For i = 0 To UBound(specialChars)
fName = Replace(fName, specialChars(i), vbNullString)
Next
CleanFileName = fName
End Function
Segundo código
Public Sub CleanUsedRange(ByRef ur As Range)
Dim arr As Variant, r As Long, c As Long
arr = ur.Formula
For r = 1 To UBound(arr, 1)
For c = 1 To UBound(arr, 2)
arr(r, c) = CleanFileName(arr(r, c))
Next
Next
ur.Formula = arr
End Sub
El código de exportación
Private Sub CommandButton2_Click()
Dim ws As Worksheet, fPath As String, fName As String, dt As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
fPath = "C:\Documents\test\"
dt = Format(Date, " - MM-DD-YYYY")
CleanUsedRange ws.UsedRange
fName = fPath & ws.Range("C10") & dt & " - Quotation"
ws.Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
End Sub
Las fórmulas de Vlook se utilizan para importar datos de otra hoja, de modo que no es necesario escribirlos uno por uno. ¿Hay alguna manera de modificar el archivo limpio para no eliminar las fórmulas de vlook?
Después de editar el código como sugeriste
Private Sub CommandButton2_Click()
Dim ws As Worksheet, fPath As String, fName As String, dt As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
fPath = "C:\Users\Documents\test\\"
dt = Format(Date, " - MM-DD-YYYY")
Range("C10") = CleanFileName(Range("C10"))
fName = fPath & ws.Range("C10") & dt & " - Quotation"
ws.Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
End Sub
Sin embargo, el archivo exportado parece tener símbolos extranjeros... como a continuación
¿Alguna otra solución?
Cambié el código como sugirió, pero no quiero poder ejecutar VBA. Después de agregar esto:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
Aquí es donde apunta el error.
Open FULL_PATH For Input As fId
ver fotonuevo error
También encuentre el código hexadecimal que solicitó.
He cambiado el código a
Else sz = txtLen + 3
Sin embargo, sigo recibiendo el error 76 adjunto.error 76 Y la depuración apunta a esta línea;
Open FULL_PATH For Input As fId
Respuesta1
No creo que tus suscriptores CleanUsedRange()estén CleanFileName()eliminando (completamente) tus Vlookfórmulas (cualesquiera que sean), pero tus fórmulas podrían destruirse al CleanFileName()eliminar ciertos caracteres.
Para explicar por qué su código actual crea problemas, analicemos algunas líneas:
En CommandButton2_Click()ti llamas CleanUsedRange ws.UsedRange. Aquí, wsse refiere "Sheet1"y UsedRangerepresenta el rango utilizado de ws, es decir, el rango de celdas entre la primera y la última columna (inclusive) y la primera y la última fila (inclusive), que tienen (o han tenido) contenido (por ejemplo, datos o fórmulas).
Está CleanUsedRange()recorriendo todas las celdas (cada fila y columna) del rango utilizado (pasado como ur As Range) y consultando CleanFileName()el contenido de todas estas celdas. Esta función ( CleanUsedRange()) es la razón principal de la destrucción de sus fórmulas, porque pasa las fórmulas en su hoja de trabajo como cadenas a la CleanFileName()función.
En CleanFileName(), el argumento pasado se verifica en busca de ciertos caracteres que no sean válidos en los nombres de archivos. Luego, el argumento modificado se devuelve como resultado de la función.
Solución: no pase todo el rango usado a CleanUsedRange()y CleanFileName(). De hecho, puedes deshacerte del CleanUsedRange()sub por completo.
Pase solo la celda (C10 ?) que contiene el nombre del archivo que podría necesitar limpieza a CleanFileName().
OIA, en CommandButton2_Click()reemplazo
CleanUsedRange ws.UsedRange
con
Range("C10") = CleanFileName(Range("C10")).
(Suponiendo que la celda C10contenga el nombre del archivo que se utilizará).
Editar sobre "signos de interrogación en cuadros"
Para el problema con los "signos de interrogación encuadrados", descubrí que cualquier carácter con código menor a 32 produce el problema en un .pdfarchivo producido por Excel (en mi Excel, solo Chr(12) se muestra como un "signo de interrogación encuadrados") . Claramente hay dos de estos caracteres entre cada campo, y los probables son un par de "Retorno de carro - Avance de línea" (CRLF), pero solo usted puede confirmarlo, ya que aún no ha proporcionado esa información.
Cuando lees los valores de la txtcadena, utilizas este código:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
Cambiándolo a
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
Como sugerí en un comentario, soluciona el problema.
Editar sobre el error 7.8.2018
Primero, gracias por el archivo. Confirma claramente mi sospecha sobre un par CRLF entre los campos del archivo. También confirma que la longitud de los datos que extraemos con la Mid$()función debe reducirse en 2 en lugar de 1.
No he podido reproducir el error que experimentó con la modificación anterior, pero efectivamente todavía hay un error con el último campo ("Fecha"). Posiblemente eso se plantee como un error en tu entorno, en el mío no está, pero erróneamente se muestra el año como 201.
El error con el último campo es que la szvariable necesita crecer para compensar el cambio anterior que hicimos en la extracción de datos (cambiamos sz - found - 1a sz - found - 2).
Entonces, cambia
Else sz = txtLen + 2
a
Else sz = txtLen + 3
Por supuesto, esto sólo ayuda si el error ocurre al leer el último campo ("Fecha") del archivo. Si esto no ayuda, depure y avíseme qué campo está leyendo y qué valores tienen las variables cuando kfalla . También informe sobre cualquier mensaje emergente que pueda aparecer.foundsz