|
こんにちは。
取りあえず自分の環境に合わせて試してみましたが動きました。
意味の無い所はコメントにしましたが.....。
また、定数の宣言しているのに何でそれを使わないのでしょうか?
全部修正しようと思いましたが、1部だけにして原文と同じようにしました。
Private Sub CommandButton1_Click()
Dim mySheet As Worksheet
Set mySheet = ActiveWorkbook.Worksheets("送品明細")
mySheet.Copy
MsgBox "新規ブックにシートをコピーしました"
Dim WshShell As Object
Dim MyF As String
Set WshShell = CreateObject("WScript.Shell")
WshShell.CurrentDirectory = "\\JPSFOL_svr1\D\Jaka\"
'Const myDir As String = "\\123.456.78.9\製造課\送品明細書\"
Const myDir As String = "\\JPSFOL_svr1\D\Jaka\MkDirTEST\"
If Dir(myDir, vbDirectory) = vbNullString Then _
MkDir myDir
'With Application
' .DisplayAlerts = False
'With Application
' .DisplayAlerts = True
'End With
'End With
Set WshShell = CreateObject("WScript.Shell")
'WshShell.CurrentDirectory = "\\123.456.78.9\製造課\送品明細書\"
WshShell.CurrentDirectory = myDir
Const myPath As String = "\\JPSFOL_svr1\D\Jaka\MkDirTEST\"
Dim myFileName As String
myFileName = Application.GetSaveAsFilename _
(ActiveWorkbook.Name, "Excelファイル(*.xls),*.xls")
If myFileName = "False" Then
Exit Sub
Else
With Application
.DisplayAlerts = False
ActiveWorkbook.SaveAs myFileName
.DisplayAlerts = True
End With
End If
End Sub
|
|