[[20120215144446]] 『特定のセルの内容を強制的にブックの保存名に』(初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『特定のセルの内容を強制的にブックの保存名に』(初心者)

 ブックを閉じるときに特定のセル(シート1)の「A1」と「B1」を
 contenate関数みたいにくっつけてブック保存名に強制的にさせる方法(マクロ?)は
 ありますか?
 どなたかご教授をお願いします。

 Excel2007
 vista

 まず、A1 と B1 の文字列連結は Range("A1").Value & Range("B1").Value
もし、これに ".xls" 付加するなら Range("A1").Value & Range("B1").Value & ".xls"

 次に、名前をつけて保存するコードは、その操作をマクロ記録すれば生成される。

 まずは、この2つを組み合わせればいいんだよ。
(厳密に言えば、双方のセルがともに空白だったり、あるいはブック名に使えない文字が入っているかどうかのチェックをしたり、そういった配慮も必要だけど)

 (ぶらっと)

ぶらっと様

ご教授ありがとうございました。
下記のように既にあったマクロと組み合わせてみましたが、

 Sub auto_close()
 Application.CellDragAndDrop = True

ChDir "C:\Users\Administrator\Desktop"

    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Administrator\Desktop\worksheets("sheet1").Range("A1").Value & worksheets    ("sheet1").Range("B1").Value & ".xlsm" ",
  FileFormat:=xlOpenXMLWorkbookMacroEnabled ,CreateBackup:=False

    ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
 End Sub

下記が構文エラーとなってしまいました。

  ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Administrator\Desktop\worksheets("sheet1").Range("A1").Value & worksheets    ("sheet1").Range("B1").Value & ".xlsm" ",
  FileFormat:=xlOpenXMLWorkbookMacroEnabled ,CreateBackup:=False

(初心者)


 ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Administrator\Desktop\worksheets("sheet1").Range("A1").Value & worksheets    ("sheet1").Range("B1").Value & ".xlsm" ",
  FileFormat:=xlOpenXMLWorkbookMacroEnabled ,CreateBackup:=False
  ↓

 ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Administrator\Desktop\" & worksheets("sheet1").Range("A1").Value & worksheets("sheet1").Range("B1").Value & ".xlsm" ",
  FileFormat:=xlOpenXMLWorkbookMacroEnabled ,CreateBackup:=False


 アドバイスいただき、
 ありがとうございます。
 説明が足りなかったと思うのですが、
 決まった名前で保存するファイルを作成する際は、毎回、定型の原本を使います。
 今回やりたいマクロは、この原本のシート1のセルA1にある「棚卸」という内容と
 セルB1にある「日付」を強制的に保存名にするというものです。
 デスクトップに「棚卸」+「日付」+「xlsm」という名前で保存されるというものです。
  上に書いていただいたコードでやってみましたが、 FileFormat:=xlOpenXMLWorkbookMacroEnabled ,CreateBackup:=Falseの:=xで構文エラーとなりました。

(最新版)
Sub auto_close()
Application.CellDragAndDrop = True
ChDir "C:\Users\Administrator\Desktop"ActiveWorkbook.SaveAs Filename:="C:\Users\Administrator\Desktop\" & Worksheets("sheet1").Range("A1").Value & Worksheets("sheet1").Range("B1").Value & ".xlsm"", FileFormat:=xlOpenXMLWorkbookMacroEnabled ,CreateBackup:=False"

 ActiveWorkbook.RunAutoMacros Which:=xlAutoClose

End Sub

なお、別のマクロでthis workbookに記載した

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim myStr As String
With Worksheets("棚卸実施日")
Set myRng = Union(.Range("A19:E25"), .Range("F19:J25"))
End With
If WorksheetFunction.CountA(myRng) < 2 Then
Cancel = True
myStr = "未入力セルがあります" & vbCrLf & _
"[OK....保存しないで終了]" & vbCrLf & _
"[キャンセル..編集に戻る]"
If MsgBox(myStr, vbOKCancel) = vbOK Then
End If
End If
End Sub

というマクロも動かなくなってしまいました。
今回のマクロと構文的に両立できるかもわかりません。

上記の説明でお分かりいただけるか自信がないのですが、
引き続きご指導をお願いします。

(初心者)


 ActiveWorkbook.SaveAs の構文訂正レスは、私ではなく、なまえなしさんからのものだけど、
とりあえず、そこだけに絞ると以下。コードが長いので、何行かに改行して記載。
そのほかのことについては、まだよんでいないので後ほど。
デスクトップのフォルダパスは、ログインユーザIDがその中に必要になったり、あるいは、Windowsバージョンで
そのパス構成そのものが異なってくるのでアップされたような、「文字列のハードコーディング」は好ましくない。
これについても、後ほど。

    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Administrator\Desktop\" & _
        Worksheets("sheet1").Range("A1").Value & Worksheets("sheet1").Range("B1").Value & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 なお、この掲示板では文章(あるいはコード)の1ブロック(空白行でわけられた部分)の先頭に「半角スペース」をいれないと
改行が無視され、ずらずら1行に扱われるので注意してね。
(画面上部の「初めての方へ」をクリックして、その中の「(5)Wikiに書き込む場合の整形ルール(2006/09/17 追加)」をよんでおいて。

 (ぶらっと)


 追加で。

 >なお、別のマクロでthis workbookに記載した ・・・・・
 >というマクロも動かなくなってしまいました。今回のマクロと構文的に両立できるかもわかりません。 

 アップされた 標準モジュールの Auto_Close と ThisWorkbookモジュールの Workbook_BeforeClose は
同じブックということだね?
で、なぜ、わけているの?

 さらに追加)

 「動かなくなってしまった」というのは、本当に動いていないの?
それとも、メッセージがでなかったので動いていないんだろうと判断してる?

 さらに、さらに追加)

 コードの中で、「ActiveWorkbook」 が登場するけど、これは、このマクロが書かれているブックを想定しているの?
それとも、別のブック?

 (ぶらっと)

 ぶらっと様
 ご教授ありがとうございます。
 改行の件、申し訳ありません。
 気をつけます。

 アップされた 標準モジュールの Auto_Close と 
 ThisWorkbookモジュールの  Workbook_BeforeClose は
 同じブックということだね?
 で、なぜ、わけているの?
 ⇒特に意味はありません。基本的な機能が分かっていなく、別々のタイミングで
 マクを 作ったためです。

 「動かなくなってしまった」というのは、本当に動いていないの?
 それとも、メッセージがでなかったので動いていないんだろうと判断してる?
 ⇒ご指摘のとおりです。

  コードの中で、「ActiveWorkbook」 が登場するけど、これは、このマクロが
 書かれてい るブックを想定して いるの?
 
 ⇒ActiveWorkbookは、このブック(原本)だと思います。
  原本に記入者が自分の名前を入力していなければ、保存できないこととし、
 名前が入力された段階で、ブックを閉じる⇒保存するをクリックすると、
 デスクトップにこの原本をコピーした別のファイルが保存される。
 この保存される新しいファイルには、原本のシート1のセルA1にある
 「棚卸」という内容とセルB1にある「日付」を強制的に保存名にするというものです。
 (デスクトップに「棚卸」+「日付」+「xlsm」という名前で保存される)。
 
 以上ですが、ご確認をお願いします。

 (初心者)


 エクセルを終了する際に、何を行いたいのか、わかったようで、まだわかりきっていない。
 コード自体にも、気になるところがいくつか。

 1.やりたいことは以下?
   1)まず、A19:J25の領域で入力されたセルが「2セル未満」ならエラーメッセージを出して、
    それでもいいということなら保存しないで終了、キャンセルなら終了要求を取り消してブックに戻る。
    (コードがそうなっているかどうかは別にして)
   2)A19:J25の入力セルが2セル以上なら、指定の名前をつけて保存。
   3)元ブックに対しては何もしない。

 2.要件として疑問に思うところ
   1)元ブックそのものを修正して「元ブックとして」保存したいケースがあっても、それはできなくなる仕組みだけどいいの?
   2)コピーされたブックにも、マクロがくっついてできあがるので、それを開いて、閉じる際に、
     わずらわしいメッセージがでるけどいいの?
     それとも、コピーブックはマクロなしにしたいの?

 3.コードとして気になるところ
   1)Application.CellDragAndDrop = True これを、あえて記述している理由(というか目的)を教えて。
   2)Auto_Close の最後にActiveWorkbook.RunAutoMacros Which:=xlAutoClose を記述している意図を教えて。

 で、そもそものAuto_Close処理は構文エラーを直した後、うまくいったのかな?

 (ぶらっと)

ぶらっと様

 ありがとうございます。
 Set myRng = Union(.Range("A19:E25"), .Range("F19:J25"))
 End With
 If WorksheetFunction.CountA(myRng) < 2 Then
 の意味が分かっていなく、教えていただいたコードをそのまま使ったのですが、
 やりたいことは、Range("A19:E25"), Range("F19:J25"))の2セルに
 それぞれ名前を入力 しなければ、ブックを閉じることが出来ない仕組みを
 作ることでした。
 今回相談したマクロに取り組むまでは、このマクロは上手くいっていました。
 (どこかをいじってしまったのか理由は、今でも理解できていません)

 1.やりたいことは以下?⇒その通りでございます。

 1)元ブックそのものを修正して「元ブックとして」保存したいケースがあっても、
 それはできなくなる仕組みだけどいいの?⇒元ブックは、原本です。
 コピー保存される側に棚卸の結果を入っているため、その仕組みで
 良いと考えています。
 2)コピーされたブックにも、マクロがくっついてできあがるので、それを開いて、
 閉じる際に、わずらわしいメッセージがでるけどいいの?
 それとも、コピーブックはマクロなしにしたいの?⇒色々な機能をマクロで
 制御してい るので、マクロありで結構です。

 1)Application.CellDragAndDrop = True これを、あえて記述している
 理由(というか目的)を教えて。
 ⇒これは、バーコードを使って棚卸をするため、ドラッグ&ドロップ
 出来ない方が入力ミス防止に役立つと思っ たからです。
 2)Auto_Close の最後にActiveWorkbook.RunAutoMacros Which:=xlAutoClose
 を記述 している意図を教えて。 ⇒これは、最初に教えていただいたマクロ記録を
 そのまま使ったためで内容については、あまり理解できていません。

 そもそものAuto_Close処理は構文エラーを直した後、うまくいったのかな?
 ⇒上手くいきません。

 Set myRng = Union(.Range("A19:E25"), .Range("F19:J25"))
 End With
 If WorksheetFunction.CountA(myRng) < 2 Then
 この辺がおかいしいのかな?と思います。

 (初心者)

 >Range("A19:E25"), Range("F19:J25"))の2セル

 A19:E25 と F19:J25 はそれぞれ結合セルなの?

 >それぞれ名前を入力

 A19:E25 のセルに1つ、F19:J25のセルに1つということ?

 >バーコードを使って棚卸をするため、ドラッグ&ドロップ

 Auto_Close つまり、もうブックを閉じてしまうルーティンの最後、ということは、この後は誰も何もできないんだよ。

 >ActiveWorkbook.RunAutoMacros Which:=xlAutoClose

 わからないねぇ。このマクロブックに書かれた Auto_Open プロシジャのコードをアップしてくれるかな?

 >上手くいきません。

 どう、うまくいかなかった?
 エラーになった?なら、エラーになったコードはどれか、エラーメッセージは何だったか?
 エラーじゃないけどうまくいかないということなら、どのようにうまくいかなかったのか具体的に説明して。

 ★ところで、この元ブックを、コピーもせず、元ブックも変更しないで、保存なしで閉じてしまうということも
 ありうるよね。
 今のコードの構成(構想)だと(今はコードの不具合があるので動かないと思うけど)名前が入力されれば「必ず」別名保存されるけど?

 (ぶらっと)

ぶらっと様
 ありがとうございます。
 Range("A19:E25"), Range("F19:J25"))の2セル
 A19:E25 と F19:J25 はそれぞれ結合セルなの?
 それぞれ名前を入力
 A19:E25 のセルに1つ、F19:J25のセルに1つということ?
 ⇒ご指摘のとおり、各結合セルです。そこに各1人分の名前を入れます。
 わからないねぇ。このマクロブックに書かれた Auto_Open プロシジャのコードを
 アップしてくれるかな?
 ⇒下記のとおりです。
 Sub auto_open()
 Application.CellDragAndDrop = False
    Sheets("棚卸実施日").Select
    Range("A18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A18").Select
    Application.CutCopyMode = False
 End Sub

 A18のセルにToday関数を入れていて、A17にopenと同時に値で返します。
 A17の値は、そのままセルB1に返されています。
 目的は、openしたときの日時を変動しないように値で固定し、
 今回のマクロで保存名の後半に利用する目的です。

 >上手くいきません。

 どう、うまくいかなかった?
 エラーになった?なら、エラーになったコードはどれか、エラーメッセージは
 何だったか?
 エラーじゃないけどうまくいかないということなら、どのようにうまく
 いかなかったのか具体的に説明して。
 ⇒上記、Range("A19:E25"), Range("F19:J25"))の2セルのうち、一つを実験的に
 空欄にして、
 閉じるボタンを押してみましたが、(画面右上の×です)普通に「原本への変更を
 保存しますか?」のメッセージが出てきてしまいました。

 ★ところで、この元ブックを、コピーもせず、元ブックも変更しないで、
 保存なしで閉じてしまうということもありうるよね。
 今のコードの構成(構想)だと(今はコードの不具合があるので動かないと思うけど)
 名前が入力されれば「必ず」別名保存されるけど?

 ⇒やりたいことを再度整理してご説明させていただきます。
 原本は、日毎の棚卸用のフォーマットです。
 日ごとにバーコードで入力した記録を残すことが目的です。
 ただ、現場に保存名の入力を任せると統一性がないので、
 原本のシート1のセルA1に「棚卸記録」B1に値で返した日付を入力しておき、
 棚卸のデータが入った新しいブック(保存名:棚卸記録20120217)をデスクトップ上に
 残すようにしたいのです。
 その際に、別マクロで申し上げた、Range("A19:E25"), Range("F19:J25"))の
 2セルの両方に名前が入力されていなければ、当該保存名でブックを
 残せないこととします。
 両方に名前が入力されて、閉じるボタン(画面右上の×)を押すと、
「原本への変更を保存しますか?」というメッセージが出てきて、
「はい」を押したときに、棚卸のデータが入った新しいブック
 (保存名:棚卸記20120217)をデスクトップ上に残します。
「いいえ」を押したときは、データ自体に価値がないものですので、
 原本は触らずにします。
 先のコメントで保存するブック形態は、マクロなしで結構でした。  
  申し訳ありません。

 (初心者)


 結局 デスクトップに保存しておきたいシートは
 どのシートですか?

 シートは二つあるんですよね?
 Sheet1 と 棚卸実施日 と言うシート。

 Sheet1のシートなんか、保存する名前を保持する為だけにある みたいな印象ですが。。。?
  >A18のセルにToday関数を入れていて、A17にopenと同時に値で返します。
  >A17の値は、そのままセルB1に返されています。
   A17の値をそのまま使えば良さそうですし。。。
  「棚卸記録」と言う所を変更しながら使い回すのが目的なのでしょうか?

 それから、イレギュラーな事が有って二回実行する様な事は無いのでしょうか?

 自動で名前を付けて保存する事にすると その辺りの対処も考えておく必要が出てくると思います。

 (HANA)


HANA様
 ありがとうございます。
 シート1と棚卸実施日は、同じシートです。
 ヤヤコシイ書き方をしました。
 申し訳ありません。
 シート1に棚卸実施日という日付と入力者の名前を入力するシートがあり、
 シート2が棚卸一覧表です。
 残したいのは、シートではなく、シート1、2を含んだ新しいブックです。
 原本には、入力者の名前と棚卸結果は、空欄です。
 これに日々棚卸結果を記入し、入力者の名前を入れて新しいブックを
 保存するのが目的です。 

 >A17の値は、そのままセルB1に返されています。
   A17の値をそのまま使えば良さそうですし。。。
  「棚卸記録」と言う所を変更しながら使い回すのが目的なのでしょうか?
⇒ご指摘のとおりですが、「棚卸記録」と言う所を変更しながら使い回すのではなく、
当初シートを作ったレイアウトの問題でたいした意味はありません。
イレギュラーなことが起こって・・・
⇒TODAY関数をそのまま保存名にしなかったのは、その後ブックを開いたときに
開いた日付で保存されると思ったからです。

保存後の編集は想定していましたが、

 イレギュラーな事態は想定していませんでした。
 どのようなことが考えられるでしょうか?

(初心者)


 簡単な所だと「同じ日に2回保存したらどうするか?」とかですが。。。

 他にも、マクロで制御するとなると、
 ユーザーには勝手な行為は慎んで貰う必要が出てくると思いますが
 それを聞いてくれる様な人なら、ルールに従った行動も
 やってくれるのではないかと思ったりしてします。。。

 現在の仕組みとしては、ブックを閉じるときに自動保存する様ですが
 「仮に保存しておきたい」とか「自分で名前を付けて保存したよ」
 なんて場合も有ったりするんじゃないかと思います。

 そう言うのが無いとして、初心者さんのイメージに近いんじゃないかと思う物を作ってみました。

 他のマクロは削除して、ThisWorkbookモジュールに以下を貼り付けて下さい。
 '------
Const ShN1 As String = "棚卸実施日"
Const ShN2 As String = "棚卸一覧表"
 '------
Private Sub Workbook_Open()
    Application.CellDragAndDrop = False
    Sheets(ShN1).Range("A17").Value = Date
End Sub
 '------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyPath  As String
Dim MyStr As String
    With Sheets(ShN1)
        MyPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
        MyPath = MyPath & "\" & .Range("A1").Value & Format(.Range("B1").Value, "yyyymmdd") & ".xls"

        If Dir(MyPath) = "" Then
            If MsgBox("本日の棚卸表を保存しますか?", vbYesNo) = vbYes Then
                If .Range("A19").Value = "" Or .Range("F19").Value = "" Then
                    MyStr = "未入力セルがあります。"
                Else
                    Sheets(Array(ShN1, ShN2)).Copy
                    ActiveWorkbook.SaveAs Filename:=MyPath
                End If
            End If
        Else
            MyStr = "本日の棚卸し表は保存済みです。"
        End If
        If MyStr <> "" Then
            MyStr = MyStr & vbCrLf & vbCrLf & _
                "[OK....保存しないで終了]" & vbCrLf & _
                "[キャンセル..編集に戻る]"
            If MsgBox(MyStr, vbOKCancel) = vbCancel Then
                Cancel = True
            End If
        End If
        If Cancel = False Then
            Application.CellDragAndDrop = True
            ThisWorkbook.Saved = True
        End If
    End With
End Sub
 '------

 棚卸実施日シートのA17セルには、直接日付を書き込みますので
 A18セルの関数は不要です。
 B2セルの関数は必要です。=A17 の式を入れておいて下さい。

 マクロは、条件が整ったとき、2枚のシートを別ブックにコピーして
 そのブックをデスクトップに保存します。
 原本ブックは閉じますが、保存したブックは開いたままです。
 また、保存したブックにマクロは含まれていません。

 (HANA)

HANA様
 ありがとうございます。
 いただいたコードでやりたいことが出来ました。
 一つだけ問題があります。
 原本が保存されずに、閉じられるため、
 いただいたコード内容を保存できません。
 一度、原本をそのまま、消さずにいただいたコードを
 記録した状態の原本として、保存、運用したいのですが、
 良い方法はあるでしょうか?
 宜しくお願いします。

(初心者)


 上書き保存 とか出来ませんか?
 保存前(BeforeSave)にコードを入れようかと思ったのですが
 そういった事が有っても面倒なのでご予定通りBeforeCloseのままにしてあります。

 うっかり上書き保存してしまわない様に、ブック完成後は
 読み取り専用にしておかれると良いかもしれません。

 名前を付けて保存 等も普通に使えると思いますよ?

 (HANA)

HANA様
 本当にありがとうございました。
 名前を付けて保存で普通にして出来ました。

(初心者)


以前、教わりました下記、コードは、原本のデータを蓄積しない形になっていますが、
原本のデータを日々蓄積する「累積型」にするにはどうしたら良いでしょうか?

できれば、新しいコピーをデスクトップに貼り付けると同時に、原本側のデータを保管したまま、
強制的に保存し、ブックを閉じるようにしたいです。
よろしくお願いします。

(以前、教えていただいたコード)
Const ShN1 As String = "棚卸実施日"
Const ShN2 As String = "棚卸一覧表"

 '------
Private Sub Workbook_Open()
    Application.CellDragAndDrop = False
    Sheets(ShN1).Range("A17").Value = Date
End Sub
 '------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyPath  As String
Dim MyStr As String
    With Sheets(ShN1)
        MyPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
        MyPath = MyPath & "\" & .Range("A1").Value & Format(.Range("B1").Value, "yyyymmdd") & ".xls"

        If Dir(MyPath) = "" Then
            If MsgBox("本日の棚卸表を保存しますか?", vbYesNo) = vbYes Then
                If .Range("A19").Value = "" Or .Range("F19").Value = "" Then
                    MyStr = "未入力セルがあります。"
                Else
                    Sheets(Array(ShN1, ShN2)).Copy
                    ActiveWorkbook.SaveAs Filename:=MyPath
                End If
            End If
        Else
            MyStr = "本日の棚卸し表は保存済みです。"
        End If
        If MyStr <> "" Then
            MyStr = MyStr & vbCrLf & vbCrLf & _
                "[OK....保存しないで終了]" & vbCrLf & _
                "[キャンセル..編集に戻る]"
            If MsgBox(MyStr, vbOKCancel) = vbCancel Then
                Cancel = True
            End If
        End If
        If Cancel = False Then
            Application.CellDragAndDrop = True
            ThisWorkbook.Saved = True
        End If
    End With
End Sub

(初心者)


 イメージがよく分からないのですが。。。

 過去のデータも一緒にデスクトップに保存するのですか?
 入力する場所とは別に蓄積する場所を設ける のですか?
 前回のデータと今回のデータを振り分けながら保存するのですか?

 など、仕様を詰めて貰う必要が有ると思います。

 (HANA)

HANA様

 いつも分かりづらい説明で、申し訳ありません。
 過去のデータも一緒にデスクトップに保存するのですか?
 →@「ファイル名に日付の入ったマクロでないファイル」をデスクトップに
 保存しま す。
 Aマクロファイルの原本も、「日付の入ったマクロでないファイルをデスクトップに
 保存した内容」を残してデスクトップに保存します。
 前に相談させていただいた時の原本と異なり、今回は、A列に昨日の棚卸結果、B列に
 今日の棚卸結果、C列に明日の棚卸結果・・・というように過去のデータを残したまま
 保存したいのです。

 入力する場所とは別に蓄積する場所を設けるのですか?
 →上記に申し上げた通り、横列に日付、縦行に製品欄が入り、日々の棚卸の結果を
「ファイル名に日付つきのマクロでないファイル」とマクロファイルの原本版は、
 同一内容になります。
 そのまま、日々更新していく構造です。
 日付入りのファイルは、日々保存したものを残しておいて、データ検証用に使います。

 説明が悪く、申し訳ございませんが、ご確認をお願いします。

 (初心者)


 原本ブックは【上書き保存】して終了
 って事ですか?

 >ThisWorkbook.Saved = True
 って所が有りますがそれを
  ThisWorkbook.Save
 に変えて やってみてもらえますか?

 (HANA)

HANA様

ありがとうございます。
上手くいき、保存ができました。

(初心者)


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.