- ベストアンサー
エクセル・名前を付けて保存するマクロ 不要な文字を消す方法
お世話になります。 エクセルで「名前をつけて保存」のマクロを作って使用していますが、 一部、改造したいところがあります。 B20セルの文字が自動でファイル名になるようにしています。 「件名：●×商店納品見積書_20090125_1326」という感じなのですが、 最初の「件名：」という文字が不要で、毎回手動で消しています。 しかし、この文字を最初から消しておくわけにはいかず、 マクロ実行時のみ「件名：」が消えるようにしたいのです。 よい方法はありますか？ どうぞよろしくお願いします。 Sub ブック保存() Dim SaveFileName As String, re As Variant, WSH As Variant, Path As String Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("Desktop") & "\" With Sheets("見積書").Range("B20") If .Value = "" Then MsgBox "店舗名が入力されていません", vbExclamation Exit Sub Else SaveFileName = Path & .Value & "_" & Format(Now, "yyyymmdd_hhmm") End If End With Set WSH = Nothing re = Application.GetSaveAsFilename(SaveFileName) If re = False Then MsgBox "保存中止", vbExclamation Else ActiveWorkbook.SaveAs SaveFileName MsgBox "保存OK", vbInformation End If End Sub
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- xls88
- ベストアンサー率56% (669/1189)
これだけのコードが書けるレベルの方が悩まれる内容と思えません。 色々方法はあると思いますが、一例です。 確かExcel2000以降なら、Split関数を使えば簡単です。 一部だけ、関係するところを掲載します。 Dim FName As String With Sheets("見積書").Range("B20") If .Value = "" Then MsgBox "店舗名が入力されていません", vbExclamation Exit Sub Else FName = Split(FName, "：")(1) SaveFileName = Path & FName & "_" & Format(Now, "yyyymmdd_hhmm") End If End With でどうでしょうか？
お礼
どうもありがとうございました。 おかげさまで解決いたしました。
関連するQ&A
- エクセルのマクロを利用して
マクロ初心者でです。 いろんなサイトから引用させて頂き次のようなマクロを作成しました。 実行すると、日付と担当者氏名(A1)がファイル名となるものです。 そこで教えて頂きたいのですが、実行すると保存先がマイドキュメントに なるのですが、これを例えば「C:\日報」というフォルダが指定されるようにしたいのですが、 自分なりに、いろいろ試したのですが全くできません。 宜しくお願い致します。 Sub 名前をつけて保存() Dim SaveFileName As String, re As Variant With Sheets("sheet1").Range("A1") If .Value = "" Then MsgBox "名前が入力されていません", vbExclamation Exit Sub Else SaveFileName = Format(Now, "yyyymmdd") & "_" & .Value End If End With re = Application.GetSaveAsFilename(SaveFileName) If re = False Then MsgBox "保存を中止しました", vbExclamation Else MsgBox "日報をを保存しました", vbInformation End If End Sub
- ベストアンサー
- その他MS Office製品
- シートだけを保存したいのですが？
はじめましてマクロ初心者です。 検索しましたがわからなかったので、質問させていただきます。 保存をキャンセルすると新規ブックができてしまいます。 キャンセルした時に新規ブックを作りたくないのですが、教えてください。 Sub シート保存() Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか？", vbYesNo) If Answer3 = vbYes Then Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy Else MsgBox ("キャンセルしました。") End If 既定ファイル名 = Range("V8") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else ActiveWorkbook.SaveCopyAs 保存ファイル名 End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel2007VBAを使ってPDF保存するには
宜しくお願い致します。 あるサイトを参考に自分の設定を下記情報に設定しました。 保存の画面が出るのですが、【OK】しても実際にはデスクトップには保存されません。 ちゃんとデスクトップに保存をするにはどうしたら良いでしょうか？ VBAの知識はなく、さっぱりわかりません。 どうぞご教授をお願い致します。 Sub SaveFileSample011() Dim SaveFileName Dim wScriptHost As Object, strInitDir As String 'カレントディレクトリをデスクトップに変更 a = Range("a2").Value b = Range("c9").Value Set wScriptHost = CreateObject("WScript.Shell") ChDir wScriptHost.SpecialFolders("Desktop") SaveFileName = Application.GetSaveAsFilename(a & "様" & b, "PDFとして保存,*.pdf") If SaveFileName <> False Then MsgBox "入力されたファイル名は、" & SaveFileName & " です。", vbInformation Else MsgBox "キャンセルがクリックされました。", vbInformation End If End Sub
- ベストアンサー
- その他MS Office製品
- OSがVistaのエクセル2007で作ったファイルがＸｐのエクセル２００３で読み取れない
すいません。教えてください。 Vista PCエクセル2007で保存したファイルが、XP PCエクセル2003で見ると文字化けしてしまうのですが、どこがいけないのか教えてください。 Sub 保存シートの名前を付けて保存() ' シート保存 Macro '***このマクロは見積もり番号と件名を保存ファイル名にし保存します。*** Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか？", vbYesNo) If Answer3 = vbNo Then MsgBox ("キャンセルしました。") Exit Sub End If Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy 既定ファイル名 = Range("V7") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel 97-2003ブック, *.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" ActiveWorkbook.Close (False) Else ActiveWorkbook.SaveCopyAs 保存ファイル名 ActiveWorkbook.Close (False) End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロでファイルを開く
エクセルの「ファイルを開く」ダイアログボックスを使用してファイルを開き、その開いたファイルに対してとあるマクロを実行させたいと思っています。 エクセルの「ファイルを開く」ダイアログボックスでパス取得までは理解出来たのですが、その先の処理が分かりません。 「ファイルを開く」と言うのは、「現在アクティブになっているシートにデータを貼り付けて」の処理でも構いません。 Dim Ret As Variant Ret = Application.GetOpenFilename("Excel ブック (*.xls), *.xls, テキストファイル(*.txt),*.txt") If Ret = False Then MsgBox "キャンセルが選択されました。" Exit Sub Else 'ここにRetで取得しているパスのファイルを開いて、sub_WAITのマクロを実行させたいです。 sub_WAIT.Show End If End Sub
- ベストアンサー
- オフィス系ソフト
- Excel マクロで.xlsx形式で保存したい
マクロでCSVファイルを開き加工を行った後、名前を付けて保存しようとしていますが（.xls） では保存できるのですが、（.xlsx）ではエラー1004が出て保存できません。内容としては「この拡張子は、選択したファイル形式には使用できません。[ファイル名]ボックスでファイル拡張子を変更するか、[ファイルの種類]ボックスで別のファイル形式を選択してください」と記述されています。 ご助言の程、宜しくお願い致します。 Dim initPath As String Dim saveFilePath As Variant initPath = "\\fileserver\ANT\IT\91_Users\700_SUBJECT\その他業務\Excel\" 'saveFilePath = Application.GetSaveAsFilename(initPath, "Excel File (*.xlsx),*.xlsx") MsgBox saveFilePath If Not (saveFilePath = "False") Then ThisWorkbook.SaveAs saveFilePath '←ここでエラーが発生しています。 Else MsgBox "キャンセルされました。" Exit Sub End If
- ベストアンサー
- Excel（エクセル）
- マクロ エクセル２００３ Sort
いつも回答して頂きとても感謝しています。 エクセル２０１０で作成した記述を、ほぼそのままエクセル２００３に書き写し実行した所、Sortの箇所でエラーが発生しました。 これはLoop中に実行しており、Loop1回目はエラーは発生しませんでしたが、Loop2回目ではエラーが発生しました。 確認の為、エクセル２０１０で実行した所、エラーは発生しませんでした。 いまいち原因が分からないので、間違いや抜けている箇所があれば教えて下さい。宜しくお願い致します。 問題のマクロの記述を一部下記に記載。 ※問題の記述の箇所は一番下にあります。 Dim 開始1 As Date, 開始2 As Date, 開始3 As Date Dim 終了1 As Date, 終了2 As Date Dim 最初 As Date, 最後 As Date Dim Path1 As String, Path2 As String Dim Buf1 As String, Buf2 As String Dim File As String Dim 日付c As Long Dim 項目c1 As Long, 項目c2 As Long Dim c As Long Dim MaxR As Long, MaxC As Long Dim wb As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet On Error GoTo errhandle 開始1 = InputBox("yyyy/mm/dd", "開始日設定画面") On Error GoTo 0 If 開始1 > Date Then MsgBox "現在の日付より開始日の方が新しい為検索出来ません。" Exit Sub End If On Error GoTo errhandle 終了1 = InputBox("yyyy/mm/dd", "終了日設定画面") On Error GoTo 0 If 終了1 > Date Then MsgBox "現在の日付より終了の日付の方が新しい為検索出来ません。" Exit Sub ElseIf 開始1 >= 終了1 Then MsgBox "現在の日付より終了の日付の方が新しい為検索出来ません。" Exit Sub End If 開始2 = 開始1 If Day(開始1) >= Day(終了1) Then 終了2 = DateAdd("m", 1, 終了1) Else 終了2 = 終了1 End If Set ws2 = Workbooks("アラーム収集").Worksheets("アラーム履歴一覧") MaxR = ws2.Cells(Rows.Count, 2).End(xlUp).Row If ws2.Cells(3, 3) <> "" Then ws2.Rows("3:" & MaxR).ClearContents End If Do Until 開始2 >= 終了2 File = "aaa " & Format(開始2, "yyyy年m月") Path1 = "C:\Users\Owner\Documents\" Path2 = "C:\Users\Owner\Documents\" & Format(開始2, "yyyy年") & "\" If Dir(Path1 & File & ".xlsx") <> "" Then Buf1 = Dir(Path1 & File & ".xlsx") For Each wb In Workbooks If wb.Name = Buf1 Then MsgBox Buf1 & vbCrLf & "はすでに開いています", vbExclamation Exit Sub End If Next wb Workbooks.Open Filename:=Path1 & File & ".xlsx" ElseIf Dir(Path2 & File & ".xlsx") <> "" Then Buf2 = Dir(Path2 & File & ".xlsx") For Each wb In Workbooks If wb.Name = Buf2 Then MsgBox Buf2 & vbCrLf & "はすでに開いています", vbExclamation Exit Sub End If Next wb Workbooks.Open Filename:=Path2 & File & ".xlsx" Else MsgBox (File & "が存在しません！！") Exit Sub End If Set ws1 = Workbooks(File).Worksheets("アラーム履歴") If 開始1 = 開始2 Then 最初 = 開始1 Else 最初 = Format(開始2, "yyyy/m/1") End If If 終了1 < Format(DateAdd("m", 1, 開始2), "yyyy/m/d") Then 最後 = 終了1 Else 開始3 = Format(開始2, "yyyy/m/1") 最後 = DateAdd("d", -1, DateAdd("m", 1, 開始3)) End If With ws1 MaxR = .Cells(Rows.Count, 2).End(xlUp).Row MaxC = .Cells(2, Columns.Count).End(xlToLeft).Column 日付c = .Rows(2).Find(what:="発生日時", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByColumns, _ searchdirection:=xlNext).Column .Range(.Cells(2, 日付c), .Cells(MaxR, MaxC)).Sort _ ← 問題の箇所 Key1:=.Cells(2, 日付c), order1:=xlAscending, Header:=xlYes
- 締切済み
- Excel（エクセル）
- Excel VBAで新たな保存先のパスの取得方法は？
エクセルＶＢＡで新たに一度に作成する複数のブックを保存するフォルダーをあらかじめ指定したいのですが、下記のような方法しか思い浮かびません。 もっとスマートなやり方はないでしょうか？（直接入力以外の方法で） Sub Path_Get() Dim myPath As String, damy As Variant MsgBox "作成するファイルの保存先を選択します。" _ & vbCr & "なお、表示されたファイル名は気にしないで" _ & vbCr & "下さい。（笑）" damy = Application.GetSaveAsFilename(fileFilter:="Excel (*.xls),*.xls") MsgBox damy If damy = False Then Exit Sub For i = Len(damy) To 0 Step -1 If Mid(damy, i, 1) = "\" Then myPath = Mid(damy, 1, i) Exit For End If Next i MsgBox "パスは " & myPath & "です。" End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBA 引数が2個のマクロの呼び出し方
ExcelのVBAで、 シート上のボタンがクリックされた時に呼び出す マクロ(プロシージャ)の引数が1個の時は、 コード1のようにできましたが、 引数が2個ある時は、コード2のように記述しても、 ボタンをクリックするとエラーになりますが、 【？】の部分をどのように記述すればよいのでしょうか。 (Windows10,Excel2010) -------------------コード1---------------------------------------- Sub test1() Dim row As Integer Dim wave_file_path As String For row = 1 To 2 wave_file_path = ThisWorkbook.Worksheets("Sheet1").Cells(row, 1).Value Call ボタン作成(row, wave_file_path) Next row End Sub Sub ボタン作成(ByVal row As Integer, ByVal wave_file_path As String) Dim cell_loc As String cell_loc = ThisWorkbook.Worksheets("Sheet1").Cells(row, 3).Address ThisWorkbook.Worksheets("Sheet1").Select With ActiveSheet.Buttons.Add(Range(cell_loc).Left, _ Range(cell_loc).Top, _ Range(cell_loc).Width, _ Range(cell_loc).Height) .name = "ボタン_" & cell_loc .OnAction = "'WAVE_PLAY """ & wave_file_path & "" & "'" .Characters.Text = "再生" End With End Sub Sub WAVE_PLAY(ByVal wave_file_path As String) If Dir(wave_file_path) = "" Then MsgBox wave_file_path & vbCrLf & "がありません。", vbExclamation Exit Sub End If Shell "C:\Program Files\Windows Media Player\wmplayer.exe /play /close " & wave_file_path End Sub ------------------------------------------------------------------- -------------------コード2---------------------------------------- Sub test2() Dim row As Integer Dim wave_file_path As String For row = 1 To 2 wave_file_path = ThisWorkbook.Worksheets("Sheet1").Cells(row, 1).Value Call ボタン作成(row, wave_file_path) Next row End Sub Sub ボタン作成(ByVal row As Integer, ByVal wave_file_path As String) Dim cell_loc As String cell_loc = ThisWorkbook.Worksheets("Sheet1").Cells(row, 3).Address ThisWorkbook.Worksheets("Sheet1").Select With ActiveSheet.Buttons.Add(Range(cell_loc).Left, _ Range(cell_loc).Top, _ Range(cell_loc).Width, _ Range(cell_loc).Height) .name = "ボタン_" & cell_loc .OnAction = "'WAVE_PLAY """ & wave_file_path & "" & "," & row & "'" <==【？】 .Characters.Text = "再生" End With End Sub Sub WAVE_PLAY(ByVal wave_file_path As String, ByVal row As Integer) If Dir(wave_file_path) = "" Then MsgBox wave_file_path & vbCrLf & "がありません。", vbExclamation Exit Sub End If Shell "C:\Program Files\Windows Media Player\wmplayer.exe /play /close " & wave_file_path ThisWorkbook.Worksheets("Sheet1").Cells(row, 4).Value = "再生済" End Sub -------------------------------------------------------------------
- 締切済み
- Excel（エクセル）
- EXCEL VBA におけるブック終了後の値の保存方法について
ＥＸＣＥＬ ＶＢＡについて質問があります。もしかしたら初歩的なことかもしれませんがよろしくお願いいたします。 まず、 Sub Test() Dim i As String i = InputBox("好きな果物を入力してください") Sheets("Sheet1").Range("A1").Value = i End Sub を実行し、ブックを保存して終了する。 ブックを開く Private Sub Workbook_Open() Dim k As String k = Sheets("Sheet1").Range("A1").Value If k = "みかん" Then MsgBox ("a") Else: MsgBox ("b") End If End Sub この処理を Sheets("Sheet1").Range("A1").Value = i というシート上のセルに値を保存するという方法を取らずに iの値をブック終了後もプロシージャ内に持っておくというのは可能なのでしょうか。 Publicで宣言してもブックを一度閉じると やっぱりiの値は保存されませんでした。 どうぞよろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
お礼
すばやいご回答ありがとうございます。 おかげさまでできました。