或者

                          或者

大家好,我确实需要以下代码的帮助。我使用以下代码将数据导入 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

子报表 子报表

按钮 2 命令按钮2

答案1

保存 PDF 时文件名中包含无效的特殊字符

程序CleanFileNameCleanUsedRange删除\ / : * ? | < > " 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

代码

相关内容