У меня возникли проблемы со следующим кодом. Всякий раз, когда я запускаю код vba, код CleanFileName и CleanUsedRange удаляют мои формулы Vlook.
Есть ли способ использовать CleanFileName и CleanUsedRange без удаления формул Vlook. коды ниже
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
Чистый файл
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
Второй код
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
Код экспорта
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
Формулы Vlook используются для импорта данных с другого листа, поэтому вам не нужно вводить их один за другим. Есть ли способ выкрутить чистый файл, чтобы не удалять формулы vlook.
После редактирования кода, как вы предложили
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
Тем не менее, экспортированный файл, похоже, имеет иностранные символы .. как показано ниже
Любое другое решение?
Я изменил код, как вы предложили, но я не могу запустить VBA. После добавления этого:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
Это где ошибка указывает
Open FULL_PATH For Input As fId
Смотрите картинку новая ошибка
Также найдите требуемый шестнадцатеричный код
Я изменил код на
Else sz = txtLen + 3
Тем не менее, я все еще получаю сообщение об ошибке 76 Ошибка 76 И отладка указывает на эту строку;
Open FULL_PATH For Input As fId