[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAでシート作成』(rinrin)
Excell2010にコマンドボタンを設定し、”Cmd発注”をクリックすると、必要なメインのExcellシートだけをメイン画面の”実績”フォルダに作成したいです。。。
ではありますが、現状では全く意図していないところに
新しく作成したシートが出来ちゃいます。。。。
どう修正すればよいのか。ご指導よろしくお願いいたします。
Sub Cmd発注()
Dim i As Single Dim Iret As Single Dim Size As Single Dim lReturn As Long Dim ActiveFile As String Dim SaveFile, SaveFile1, Hinichi As String Dim OpenFile_Name As String Dim OpenFile_Name_Dir As String
'問い合せダイアログの表示をOFFにします
Application.DisplayAlerts = False
'依頼?m?成
OpenFile_Name = ActiveWorkbook.Path
File購入依頼書 = Sheets("治工具").Range("H6").Value Range("H6").Select Selection.UnMerge Range("H6").Select Selection.Copy Range("P6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("P6").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-8],""/"","""")" File購入依頼書 = ActiveCell.Value '保存 Sheets("治工具").Select Range("A8").Select Sheets("治工具").Copy After:=Sheets(4) ActiveSheet.Name = File購入依頼書 ActiveFile = ActiveSheet.Name
Sheets(File購入依頼書).Select Sheets(File購入依頼書).Copy
'フォルダ名がなければ作成する
OpenFile_Name_Dir = OpenFile_Name & "\実績\" 'Openフォルダ名取得
If Dir(SaveDir, vbDirectory) = "" Then MkDir "実績" MkDir OpenFile_Name_Dir End If
ActiveWorkbook.SaveAs _ FileName:=File購入依頼書 & "xls"
Hinichi = File購入依頼書 Size = Len(File購入依頼書) 'フルパス名長
SaveFile = OpenFile_Name_Dir & File購入依頼書 & ".xlsx" '保存ファイル名創生
Workbooks(1).Activate Sheets(File購入依頼書).Select Sheets(File購入依頼書).Delete
Workbooks(2).Activate
Size = Len(SaveFile) 'フルパス名長 For i = Size To 1 Step -1 If Mid(SaveFile, i, 1) = "\" Then SaveFile1 = Right(SaveFile, Size - i) 'Openフルパス名取得 Exit For End If Next i
Range("A8").Select Retry: Iret = MsgBox("『" & SaveFile & "』 で保存しますが、宜しいですか?" & vbCrLf + vbLf & "フォルダーを変更する場合は『いいえ』を選択して下さい。", vbQuestion + vbYesNo) If Iret = vbYes Then Exit Sub Else
lReturn = Application.Dialogs(xlDialogSaveAs).Show(arg1:=SaveFile1, arg2:=18) '保存画面 document_text、type_num、prot_pwd、backup、write_res_pwd、read_only_rec If lReturn = False Then 'CanselならばRetryに戻る GoTo Retry End If End If
GoTo FIN CHK: If Err.Number = 76 Then 'Pathが存在しない場合にフォルダー作成 MkDir OpenFile_Name & File購入依頼書 Else MsgBox (Err.Description) End If Resume Next
'問い合せダイアログの表示をONに戻します
Application.DisplayAlerts = True '発注Skip: FIN: End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
MkDir "実績"
あと、以下のようにセットしたファイル名ですが、
File購入依頼書 = Sheets("治工具").Range("H6").Value
数行下で、以下に変わってます。
File購入依頼書 = ActiveCell.Value
で、ご質問の保存場所ですが、
ActiveWorkbook.SaveAs _ FileName:=File購入依頼書 & "xls"
この部分で、フォルダを指定していないせいでは?
(???) 2015/04/23(木) 18:54
今すぐには確認はとれないのですが、とりいそぎお礼を伝えたくて返事を書きました。。。
ホントにありがとうございます。。。;;
またわからなくなったとき お助けいただけたら幸いです。。。^^
ありがとうございました。。。。。。。。。^^
(rinrin) 2015/04/23(木) 20:29
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=76978;id=excel
(マルチネス) 2015/04/24(金) 08:16
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=76989;id=excel
(マルチネス) 2015/04/25(土) 00:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.