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 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 arquivo limpo
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 utilizadas para importar dados de outra planilha, para que não seja 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
Alguma outra solução?
Alterei o código como você sugeriu, mas não consigo executar o VBA. Depois de adicionar isto:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
É aqui que o erro está apontando
Open FULL_PATH For Input As fId
Ver fotonovo erro
Encontre também o código hexadecimal que você solicitou
Eu mudei o código para
Else sz = txtLen + 3
No entanto, ainda estou recebendo o erro 76 anexadoErro 76 E o debug está apontando para esta linha;
Open FULL_PATH For Input As fId
Responder1
Eu não acho que seus substitutos CleanUsedRange()estejam CleanFileName()realmente excluindo (completamente) suas Vlookfórmulas (sejam elas quais forem), mas suas fórmulas podem ser destruídas ao CleanFileName()remover 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, wsrefere-se "Sheet1"e UsedRangerepresenta o intervalo usado de ws, significando o intervalo de células entre a primeira e a última colunas (inclusive) e a primeira e a última linhas (inclusive), que possuem (ou tiveram) conteúdo (por exemplo, dados ou fórmulas).
Você CleanUsedRange()está percorrendo todas as células (cada linha e coluna) do intervalo usado (passado como ur As Range) e chamando CleanFileName()o conteúdo de todas essas células. Esta função ( CleanUsedRange()) é o principal motivo da destruição de suas fórmulas, pois ela passa as fórmulas da sua planilha como strings para a CleanFileName()função.
Em CleanFileName(), o argumento passado é verificado em busca de determinados caracteres 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 abandonar CleanUsedRange()totalmente o submarino.
Passe apenas a célula (C10?) que contém o nome do arquivo que pode precisar de limpeza para CleanFileName().
IOW, em CommandButton2_Click()substituição
CleanUsedRange ws.UsedRange
com
Range("C10") = CleanFileName(Range("C10")).
(Supondo que a célula C10contenha o nome do arquivo a ser usado.)
Edição sobre "pontos de interrogação em caixa"
Para o problema com os "pontos de interrogação em caixa", descobri que qualquer caractere com código menor que 32 produz o problema em um .pdfarquivo produzido pelo Excel (no meu Excel, apenas Chr(12) é mostrado como um "ponto de interrogação em caixa") . É claro que existem dois desses caracteres entre cada campo, e os prováveis são um par de "Carriage Return - Line Feed" (CRLF), mas só você pode confirmar isso, pois ainda não forneceu essa informação.
Ao ler os valores da txtstring, você usa este código:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
Mudando para
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
como sugeri em um comentário, resolve o problema.
Edição relativa ao erro 7.8.2018
Primeiramente, obrigado pelo arquivo. Isso confirma claramente minha suspeita sobre um par CRLF entre os campos do arquivo. Também confirma que o comprimento dos dados que extraímos com a Mid$()função deve ser reduzido em 2 em vez de 1.
Não consegui reproduzir o erro que você encontrou com a modificação anterior, mas ainda há um erro no último campo ("Data"). Possivelmente isso é levantado como um erro no seu ambiente, não é no meu, mas o ano é mostrado erroneamente como 201.
O erro do último campo é que a szvariável precisa crescer para compensar a alteração anterior que fizemos na extração de dados (alteramos sz - found - 1para sz - found - 2).
Então, mude
Else sz = txtLen + 2
para
Else sz = txtLen + 3
Claro, isso só ajuda se ocorrer um erro na leitura do último campo ("Data") do arquivo. Se isso não ajudar, por favor, depure e deixe-me saber qual campo você está lendo e quais valores as variáveis ktêm foundquando szfalham. Informe também sobre quaisquer mensagens pop-up que possam aparecer.