人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのマクロで困っています。
PCに不自由な父が簡単に見積書を作れるようにエクセルで体裁を整えているのですが、自分で作成した「別名で保存する」ボタンを押した時に自動で「別名で保存」をさせたいのですが、どうにもうまく行きません。

具体的には、「A3:N3」のセルに見積もりの宛名が入っているので、「別名で保存」ボタン押下後、ファイル名を「<見積もりの宛名>様分<現在の年>年<現在の月>月<現在の日>日作成見積書.xls」として保存。
(ファイル名の例:「○○○○様分2008年2月10日作成見積書.xls」)

保存処理完了後、「<保存したファイル名>という名前でファイルを保存しました。」とダイアログを表示させたいのです。
なお、ファイルの保存先は現在のユーザーのデスクトップ配下「見積書フォルダ」に保存させたいと考えています。

エクセルのマクロに詳しい方、ぜひお知恵をお貸しください。よろしくお願いいたします。

●質問者: ga-ya
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:2008年 2月10日 A3 N3 pc
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●45ポイント ベストアンサー

こんな感じでご希望のようになるでしょうか。

'--- フォルダ名:後ろに "\" を付けてください
Const FolderName = "見積書フォルダ\"

Sub ボタン1_Click()
 Dim myDeskTopPath
'--- デスクトップパスの取得
 Set MyWSH = CreateObject("WScript.Shell")
 myDeskTopPath = MyWSH.SpecialFolders("Desktop") & "\"
 
 Dim fileName As String
'--- ファイル名の作成
 fileName = Range("A3").Value & "様分" & Format(Date, "YYYY年MM月DD日") & "作成見積書.xls"

'--- ファイルの保存
 ThisWorkbook.SaveAs myDeskTopPath & FolderName & fileName

'--- メッセージの表示
 MsgBox "<" & fileName & ">という名前でファイルを保存しました。"
End Sub
◎質問者からの返答

丁寧にありがとうざいました!

おかげさまでPCに不慣れな父も結構簡単に見積がつくれるようになりました!


2 ● SALINGER
●25ポイント

「A3:N3」のセルに見積もりの宛名という部分が、マージされたセルに1つ宛名があるのか、複数のセルに複数の宛名があるのかがわかりませんが。

1つのとき

Private Sub CommandButton1_Click()
 Dim MyWSH As Object
 Dim myDeskTopPath As String
 Dim fname As String
 Dim r As Range
 
  'デスクトップのパスを取得する
 Set MyWSH = CreateObject("WScript.Shell")
 myDeskTopPath = MyWSH.SpecialFolders("Desktop")
 
 For Each r In Range("A3:N3")
 If r.Value <> "" Then
  'ファイルの名前を作成
 fname = r.Value & "様分" & Format(Now, "long date") & "作成見積書"
 
  '同名のファイルがあっても上書き保存する
 Application.DisplayAlerts = False
 
  'ブックの保存
 ActiveWorkbook.SaveAs myDeskTopPath & "\見積書\" & fname & ".xls"
 Application.DisplayAlerts = True
 
  'メッセージの表示
 MsgBox fname & "という名前でファイルを保存しました。"
 End If
 Next r
 Set MyWSH = Nothing
End Sub

複数のとき

Private Sub CommandButton1_Click()
 Dim MyWSH As Object
 Dim myDeskTopPath As String
 Dim fname As String
 Dim r As Range
 
  'デスクトップのパスを取得する
 Set MyWSH = CreateObject("WScript.Shell")
 myDeskTopPath = MyWSH.SpecialFolders("Desktop")
 
 For Each r In Range("A3:N3")
 If r.Value <> "" Then
  'ファイルの名前を作成
 fname = r.Value & "様分" & Format(Now, "long date") & "作成見積書"
 
  '同名のファイルがあっても上書き保存する
 Application.DisplayAlerts = False
 
  'ブックの保存
 ActiveWorkbook.SaveAs myDeskTopPath & "\見積書\" & fname & ".xls"
 Application.DisplayAlerts = True
 
  'メッセージの表示
 MsgBox fname & "という名前でファイルを保存しました。"
 End If
 Next r
 Set MyWSH = Nothing
End Sub

注意 \を半角¥にしてください

◎質問者からの返答

SALINGERさんもありがとうございました。

おかげさまでぶじ解決しました!

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ