大家好，我确实需要以下代码的帮助。我使用以下代码将数据导入 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 命令按钮2
答案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
