Помилка VBA 1004 під час експорту в PDF


0

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

Лист1

Subreport Subreport

Кнопка 2 командиButton2


3
Укажіть рядок коду, який генерує помилку.
Excellll

Хоча я сумніваюся, що це ваша проблема, я помітив логічний недолік, який потенційно може спричинити проблеми: found = InStr(txt, k) + Len(k) + 1завжди буде повертати значення> 0 (перевірене як таке в наступному рядку). Навіть якщо текст k не знайдений (повертає -1), ви додасте len (k) та 1 (припустимо, що k ніколи "") Як я вже сказав, напевно, ніколи не виходить з ладу, але це могло б.
Білл Хілеман

Я оновив код за допомогою рядка, який видає помилку. Plz
help

Відповіді:


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

Код


1
Коментарі не для розширеного обговорення; ця розмова переміщена до чату .
DavidPostill
Використовуючи наш веб-сайт, ви визнаєте, що прочитали та зрозуміли наші Політику щодо файлів cookie та Політику конфіденційності.
Licensed under cc by-sa 3.0 with attribution required.