Ошибка VBA 1004 при экспорте в PDF
Привет, ребята. Мне очень нужна помощь с кодом ниже. Я использую следующие коды для импорта данных в Excel:
Option Explicit
Private Sub CommandButton1_Click()
Const FULL_PATH = "C:\Users\Documents\test\customerinformation.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
================================================== ==============
Импортирование следующего, который работает нормально
Name Name1
Phone Phone1
Address1 Address11
Email Email1
Postcode Postcode1
SR SR1
MTM MTM1
Serial Serial1
Problem Problem1
Action Action1
Dated Dated1
===============================================
Моя проблема заключается в экспорте выбранного диапазона в PDF
Private Sub CommandButton2_Click()
Dim FilePath As String
Dim FileName As String
Dim MyDate As String
Dim report As String
Dim Name As String
FilePath = "C:\Users\Documents\test\"
MyDate = Format(Date, " - MM-DD-YYYY")
report = " - Quatation"
Name = Worksheets("Sheet1").Range("C10")
Sheets("Sheet1").Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=FilePath & Name & MyDate & report
End Sub
================================================== ========
или же
Private Sub report()
Dim myFile As String, lastRow As Long
myFile = "C:\Users\heal1\OneDrive\Documents\test\" &
Sheets("Sheet1").Range("C11") & "_" & Sheets("Sheet1").Range("C17") &
Format(Now(), "yyyy-mm-dd") & ".pdf"
lastRow = Sheets("Sheet3").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Transfer data to sheet3
Sheets("Sheet3").Cells(lastRow, 1) = Sheets("Sheet1").Range("C11")
Sheets("Sheet3").Cells(lastRow, 2) = Sheets("Sheet1").Range("C17")
Sheets("Sheet3").Cells(lastRow, 3) = Sheets("sheet1").Range("I28")
Sheets("Sheet3").Cells(lastRow, 4) = Now
Sheets("Sheet3").Hyperlinks.Add Anchor:=Sheets("Sheet3").Cells(lastRow, 5),
Address:=myFile, TextToDisplay:=myFile
'Create invoice in PDF format
Sheets("sheet1").ExportAsFixedFormat Type:=xlTypePDF, FileName:=myFile
Application.DisplayAlerts = False
'create invoice in XLSX format
ActiveWorkbook.SaveAs "C:\Users\Documents\test\" &
Sheets("Sheet1").Range("C11") & "_" & Sheets("Sheet1").Range("C17") & "_" &
Format(Now(), "yyyy-mm-dd") & ".xlsx", FileFormat:=51
'ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
================================================== ==============
Каждый раз, когда я пытаюсь экспортировать после импорта данных, я получаю ошибку 1004
================================================== ==========
Без импортированных данных я могу экспортировать с кодом. Но после импорта данных я не могу экспортировать снова.
Я продолжаю получать сообщение " Ошибка приложения или объекта" и Ошибка выполнения 1004 "Документ не сохранен. Возможно, документ открыт или при сохранении произошла ошибка.
это первый код, который подсвечивается при отладке
Sheets("Sheet1").Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=FilePath & Name & MyDate & Report –
Ошибка второго кода
Sheets("sheet1").ExportAsFixedFormat Type:=xlTypePDF, FileName:=myFile
введите описание изображения здесь
Пожалуйста, найдите следующие сообщения об ошибках из подотчета и кнопку 2
Подотчет Подотчет
Кнопка 2 commandButton2
1 ответ
При сохранении файлов PDF в имени файла указаны недопустимые специальные символы
процедуры CleanFileName & CleanUsedRange Удалить \ / : * ? | < > " Backspace Tab LF CR
Option Explicit
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:\Users\Documents\test\"
dt = Format(Date, " - MM-DD-YYYY")
CleanUsedRange ws.UsedRange
fName = fPath & ws.Range("C10") & dt & " - Quatation"
ws.Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
End Sub
Private Sub SaveReport()
Const FILE_PATH_1 = "C:\Users\heal1\OneDrive\Documents\test\"
Const FILE_PATH_2 = "C:\Users\Documents\test\"
Dim ws1 As Worksheet, ws3 As Worksheet, fPath As String, dt As String
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")
dt = Format(Now, "yyyy-mm-dd")
Dim cfn As String, fName As String, lr As Long
CleanUsedRange ws1.UsedRange
lr = ws3.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Transfer data to sheet3
ws3.Cells(lr, 1) = ws1.Cells(11, "C")
ws3.Cells(lr, 2) = ws1.Cells(17, "C")
ws3.Cells(lr, 3) = ws1.Cells(28, "I")
ws3.Cells(lr, 4) = Now 'or dt
ws3.Hyperlinks.Add Anchor:=ws3.Cells(lr, 5), Address:=fName, TextToDisplay:=fName
'Create invoice in PDF format
cfn = ws1.Range("C11") & "_" & ws1.Range("C17")
fName = FILE_PATH_1 & cfn & dt & ".pdf"
ws1.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
'create invoice in XLSX format
Application.DisplayAlerts = False
fName = FILE_PATH_2 & cfn & "_" & dt & ".xlsx"
ThisWorkbook.SaveAs fName, FileFormat:=51
'ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
,
Добавить оба CleanFileName а также CleanUsedRange в общий модуль
Например Module1