รบกวนแก้ไข Error ให้หน่อยครับ พอดีผมไม่ได้ใช้ Code ตามอาจารย์ แต่รองปรับเป็นแบบอื่น จากคำถามเดิม แต่มีคำถามเพิ่มเติมดังนี้ครับ
1. พอดีจะลอง Export Excel ปุ่ม Marcro ปรากฎว่า Code มีอาการ ออก Excel ได้ และออกไม่ได้ โดย Error ตาม MsgBox "Could not create PDF file"
Code: Select all
Sub Button29_EXCEL()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim codebranch As String
Dim branchname As String
Dim lictype As String
On Error GoTo errHandler
If InStr(Range("b5").value, "นายหน้า") > 0 Then
lictype = "นายหน้า"
ElseIf InStr(Range("b5").value, "ตัวแทน") > 0 Then
lictype = "ตัวแทน"
ElseIf InStr(Range("b5").value, "ร่วมใบอนุญาต") > 0 Then
lictype = "ร่วมใบอนุญาต"
End If
codebranch = Left(Range("A1"), 3)
branchname = Mid(Range("A1"), 7, 50)
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd_mm_yy")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = lictype & "_" & codebranch & "_" & branchname & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
'myFile = Application.GetSaveAsFilename _
'(InitialFileName:=strPathFile, _
'FileFilter:="PDF Files (*.pdf), *.pdf", _
'Title:="Select Folder and FileName to save")
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
'Only choice in the "Save as type" dropdown is Excel files(xls)
'because the Excel version is 2000-2003
fname = Application.GetSaveAsFilename(InitialFileName:=lictype & "_" & codebranch & "_" & branchname & "_" & strTime, _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")
If fname <> False Then
'Copy the ActiveSheet to new workbook
For Each wsA In ActiveWorkbook.Worksheets
wsA.UsedRange.Copy
wsA.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next
Set NewWb = ActiveWorkbook
Rows("1:3").Select
Selection.Delete Shift:=xlUp
'We use the 2000-2003 format xlWorkbookNormal here to save as xls
NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
Else
'Give the user the choice to save in 2000-2003 format or in one of the
'new formats. Use the "Save as type" dropdown to make a choice,Default =
'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
fname = Application.GetSaveAsFilename(InitialFileName:=lictype & "_" & codebranch & "_" & branchname & "_" & strTime, filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 2000-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xls": FileFormatValue = 56
Case "xlsx": FileFormatValue = 51
Case "xlsm": FileFormatValue = 52
Case "xlsb": FileFormatValue = 50
Case Else: FileFormatValue = 0
End Select
'Now we can create/Save the file with the xlFileFormat parameter
'value that match the file extension
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else
'Copies the ActiveSheet to new workbook
ActiveSheet.Copy
For Each wsA In ActiveWorkbook.Worksheets
wsA.UsedRange.Copy
wsA.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next
Set NewWb = ActiveWorkbook
Rows("1:3").Select
Selection.Delete Shift:=xlUp
'Save the file in the format you choose in the "Save as type" dropdown
NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
End If
End If
'End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
2.
Code: Select all
fname = Application.GetSaveAsFilename(InitialFileName:=lictype & "_" & codebranch & "_" & branchname & "_" & strTime,
ทำไมผมใช้ StrFile ไม่ได้ครับ
Code: Select all
'create default name for savng file
strFile = lictype & "_" & codebranch & "_" & branchname & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
'myFile = Application.GetSaveAsFilename _
'(InitialFileName:=strPathFile, _
'FileFilter:="PDF Files (*.pdf), *.pdf", _
'Title:="Select Folder and FileName to save")
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
'Only choice in the "Save as type" dropdown is Excel files(xls)
'because the Excel version is 2000-2003
fname = Application.GetSaveAsFilename(InitialFileName:=lictype & "_" & codebranch & "_" & branchname & "_" & strTime, _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
