VBA CleanFileName e CleanUsedRange

Question

Estou tendo algum problema com o código a seguir. Sempre que executo o código vba, o código CleanFileName e CleanUsedRange exclui minhas fórmulas Vlook.

Existe alguma maneira de usar o CleanFileName e CleanUsedRange sem excluir as fórmulas vlook. os códigos estão abaixo

 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

O CleanFile

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

O código de exportação

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

As fórmulas Vlook são usadas para importar dados de outra planilha, de modo que não é necessário digitá-los um por um. Existe uma maneira de torcer o arquivo limpo para não remover fórmulas vlook.

Depois de editar o código como você sugeriu

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

No entanto, o arquivo exportado parece ter símbolos estrangeiros ... como abaixo

Image1

Image2

Alguma outra solução?

Eu mudei o código como você sugeriu, mas eu quero incapaz de executar o VBA. Depois de adicionar isto:

 .Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))

Aqui é onde o erro está apontando

Open FULL_PATH For Input As fId

Veja a foto novo erro

Encontre também o código hexadecimal u solicitado

Hex pic

Eu mudei o código para

 Else sz = txtLen + 3

No entanto, eu ainda estou recebendo o erro 76 anexado Erro 76 E a depuração está apontando para esta linha;

 Open FULL_PATH For Input As fId

    

Answer 1

Eu não acho que seus subs CleanUsedRange() e CleanFileName() estejam realmente excluindo (completamente) suas fórmulas Vlook (quaisquer que sejam), mas suas fórmulas podem ser destruídas por CleanFileName() , pois remove certos caracteres.

Para explicar por que seu código atual cria problemas, vamos analisar algumas linhas:

Em CommandButton2_Click() , você chama CleanUsedRange ws.UsedRange . Aqui, ws refere-se a "Sheet1" e UsedRange representa o intervalo usado de ws , significando o intervalo de células entre a primeira e a última colunas (inclusive) e a primeira e última linhas (inclusive) que têm (ou conteúdo) (por exemplo, dados ou fórmulas).

Em CleanUsedRange() , você está percorrendo todas as células (cada linha e coluna) do intervalo usado (passado como ur As Range ) e chamando CleanFileName() no conteúdo de todas essas células. Esta função ( CleanUsedRange() ) é a principal razão para a destruição de suas fórmulas, porque ela passa as fórmulas em sua planilha como strings para a função CleanFileName() .

Em CleanFileName() , o argumento passado é verificado para determinados caracteres que são inválidos em nomes de arquivos. O argumento modificado é então retornado como resultado da função.

Correção: não passe todo o intervalo usado para CleanUsedRange() e CleanFileName() . Na verdade, você pode eliminar o CleanUsedRange() sub integralmente.

Passa apenas uma célula (C10?) que contém o nome do arquivo que pode precisar de limpeza, para CleanFileName() .

IOW, em CommandButton2_Click() replace

CleanUsedRange ws.UsedRange

com

Range("C10") = CleanFileName(Range("C10")).

(Assumindo que a célula C10 contém o nome do arquivo a ser usado.)

Editar sobre "pontos de interrogação em caixa"

Para o problema com os "pontos de interrogação encaixotados", descobri que qualquer caractere com código menor que 32 produz o problema em um arquivo .pdf produzido pelo Excel (no meu Excel, somente Chr (12) é mostrado como "ponto de interrogação encaixotado"). É claro que existem dois caracteres entre cada campo, e os prováveis são um par de "Carriage Return - Line Feed" (CRLF), mas somente você pode confirmar isso, pois você ainda não forneceu essa informação.

Quando você lê os valores da string txt , usa este código:

.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))

Alterando para

.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))

como sugeri em um comentário, cura o problema.

Editar sobre erro 7.8.2018

Primeiro, obrigado pelo arquivo. Isso claramente confirma minha suspeita sobre um par CRLF entre os campos no arquivo. Também confirma que o comprimento dos dados que extraímos com a função Mid$() deve ser reduzido em 2 em vez de 1.

Eu não consegui reproduzir o erro que você experimentou com a modificação anterior, mas na verdade ainda há um erro com o último campo ("Datado"). Possivelmente isso é levantado como um erro em seu ambiente, não é no meu, mas o ano é erroneamente mostrado como 201.

O erro com o último campo é que a variável sz precisa crescer para compensar a alteração anterior que fizemos na extração de dados (alteramos sz - found - 1 para sz - found - 2 ).

Então, mude

Else sz = txtLen + 2

para

Else sz = txtLen + 3

Naturalmente, isso só ajuda se o erro ocorrer ao ler o último campo ("Datado") do arquivo. Se isso não ajudar, depure e deixe-me saber qual campo você está lendo e quais valores as variáveis k , found e sz têm quando falhar. Informe também sobre quaisquer mensagens pop-up que possam aparecer.