Ошибка VBA 1004 при экспорте в PDF

Question

Ошибка VBA 1004 при экспорте в PDF

587

gist102 2018-06-13 в 14:00

Привет, ребята. Мне очень нужна помощь с кодом ниже. Я использую следующие коды для импорта данных в 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

Ошибка VBA 1004 при экспорте в PDF

Пожалуйста, найдите следующие сообщения об ошибках из подотчета и кнопку 2

Лист1

Подотчет Подотчет

Кнопка 2 commandButton2

0

Пожалуйста, укажите строку кода, которая генерирует ошибку. Excellll 5 лет назад 3

Хотя я сомневаюсь, что это ваша проблема, я обнаружил логический недостаток, который потенциально может вызвать проблемы: `found = InStr (txt, k) + Len (k) + 1` всегда будет возвращать значение> 0 (проверяется как таковое на следующая строка). Даже если текст k не найден (возвращает -1), вы добавляете len (k) и 1 (при условии, что k никогда не бывает ""). Как я уже сказал, вероятно, никогда не произойдет сбой, но это может произойти. Bill Hileman 5 лет назад 0

Я обновил код со строкой, которая выдает ошибку. Пожалуйста, помогите gist102 5 лет назад 0

1 ответ на вопрос

1

Accepted Answer · 2018-06-14 12:38:12

При сохранении 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

Ошибка VBA 1004 при экспорте в PDF

или же

1 ответ на вопрос

Похожие вопросы