[[20050528220604]] 『セルのクリックで別シートに入力＆印刷実行』（Kuro） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セルのクリックで別シートに入力＆印刷実行』（Kuro）
[セルのクリックで別シートに入力＆セルのクリックで印刷実行]
今、LAN上の共有ドライブ内のBook"受注"に以下二つのシートがあります。
sheet"受注"；数人の受注担当者が随時入力します。
・列名は、G1；受注No、H1;品名、I1；数量、J1；出荷予定日
sheet"出荷案内"；出荷案内印刷用シートです。受注担当者が受注毎にsheet"受注"に入力後、出荷案内をコピーします(出荷案内文面シートです)。
・入力(表示)セルは、D20；受注No、D21;品名、D22；数量、D23；出荷予定日
又、既にsheet"出荷案内"は、印刷したい受注NoがGxとすると、D20にsheet"受注"Gxの受注Noを入力すると、数式によりD21～23にsheet"受注"のHx～Jxが表示されるようになっています(D21～23は数式セル)。
現在は、sheet"受注"Gxをsheet"出荷案内"D20に(ハンドで)コピー＆貼り付け後、印刷(ファイル→印刷)しています。
これを以下のようにしたいのですがどのようにすればいいのでしょう？
1)sheet"受注"のGxをシングルクリックすると、sheet"出荷案内"D20にsheet"受注"Gxを入力し、画面(？)がsheet"出荷案内"に移動。
2)sheet"出荷案内"のボタンをクリックすると印刷実行し、画面(？)がsheet"受注"に移動しFxに"P"(印刷済み確認用の文字表示)と入力(表示)。
尚、1)、2)のマクロは個別でお願いします。(1,2を単独で操作可能とするために)
又、マクロ実行用ボタンの作成法も教えてください。自分でやったけど、イマイチ自信がないので・・・。
それから、ボタン上の名称を"ボタン1"とかではなく、"印刷"としたいのですがどうすれば？
受注担当者の操作を以下のようにしたいということです。
1)sheet"受注"に入力。
2)入力後、受注Noをシングルクリック。
3)sheet"出荷案内"の内容を確認して"印刷ボタン"クリックで案内書印刷(いずれはダイレクトにFAX送信)。
マクロしかないと思いますが、初心者なのでよくわかりません。よろしくお願いします。
少し疑問点があります・・・。
受注シートと出荷案内のシートは別のブックでしょうか。 また、数式でリンクさせないのはなぜでしょうか。
（川野鮎太郎）共有ファイルの意味が良くわかっていないσ(^_^;)
説明が分かり難くてすみません。
同一Book内の二つのシートです。一応、sheet"出荷案内"は数式で表示させていますがもっといい方法があるかも。
最初の質問文を書き直しました。これで分かるでしょうか？
よろしくお願いします。(Kuro)
普通のクリックではおそらく不便な場合が出るので、右クリックでやってみました。 受注シートのシートタブを右クリックして、「コードの表示」 出てきたVBEの画面に以下のコードを複写
'////////////////////////////////////ここから
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
Cancel = True
With Worksheets("出荷案内")
.Range("D20").Value = Target.Value
Application.Goto .Range("D20")
End With
End Sub
'////////////////////////////////////ここまで
次に、標準モジュールに以下のコードを複写
'////////////////////////////////////ここから
Sub MyPrint()
Set Sh1 = Worksheets("受注")
Set Sh2 = Worksheets("出荷案内")
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "D20セルは不正な値です。"
Else
Sh2.PrintOut
Application.Goto Sh1.Range("G" & MyR)
Sh1.Range("F" & MyR).Value = "P"
MsgBox MyR & "行目が印刷されました。" & vbCrLf & _
"受注№は " & MyNo & " です。"
End If
End Sub
'////////////////////////////////////ここまで
ボタンの作成は、出荷案内シートを表示させたら、表示＞ツールバー＞フォーム 出てきたフォームのツールバー内にある、「ボタン」をクリックし、配置したい場所をクリック すると、マクロの登録画面が出てくるので、先ほど複写した「NyPrint」を選択してOKです。 あとは、そのボタンの表示名をお好みに書き換えます。 ※上記はフォームのボタンで説明しましたが、オートシェープでも何でもかまいませんよ。
形や色、文字の設定など、自由度が高いように思うので、私の場合はオートシェープに登録する場合が多いです。 その場合は、オートシェープを右クリックして「マクロの登録」を選択します。
（川野鮎太郎）
ありがとうございます。もう少し教えてください。
1)最初のコードは、モジュール登録でないのはどうして？勉強のため教えてください。
モジュール登録との違いがよく分かりません。
2)コードに"D20セルは不正な値です。"というのがありますが、これは何を確認してどうだったら表示されるのでしょう？ sheet"受注"のG列受注Noは追番のため、受注前に予め入力されていますが問題ありませんか？
3)オートシェープ、ってどうやって使うのですか？もう少し詳しく教えてください。
初心者ですみませんが、よろしくお願いします。（Kuro)
一度上で書いたことを試してください。
（川野鮎太郎）
申し訳ありません。すぐに実行できる環境に無かったものですから･････。
その後やってみました。出来ました！感激です！
で、もう少し教えて頂きたいのです(変更した上記質問+下記質問)｡
宜しくお願いします。
4)sheet"受注"F列,G列とsheet"出荷案内"D20にセルの保護設定をしたままでも実行可能なように出来るのでしょうか？
5)sheet"出荷案内"で印刷ボタンを使用せずに、通常のファイル→印刷として印刷をした場合もsheet"受注"のセルFxに"P"と文字入力(表示)させることは可能でしょうか？
可能ならどのようにすれば？(この場合は、画面(？)がsheet"受注"に移動する必要は有りません｡)
6)プリンターが複数台あるのですが、印刷するプリンターをこのマクロで指定する場合はどうすれば？
申し訳ありませんが、宜しくお願いします。(Kuro)
こんな感じです。
(1)最初のコードはシートを右クリックしたときに発生するイベントコードなので、該当するシートモジュールに書きます。
標準モジュールは、ボタンなどに登録してユーザーが実行したいときに使うものです。
(2)『D20セルは不正な値です。』を入れたのは、複数人が使うってことだったので、D20セルに変なものが入力されたときに
不要な印刷がされないようにしただけで、本来は不要かもしれません。ただ、あっても不正な文字が入らなければそこは通らないから問題はありません。
(3)オートシェープは、挿入＞図＞オートシェープから図形を作成して、その図形にマクロを登録します。
登録方法は既に上で書いてます。
(4)保護したままでも可能なように、以下のコードに修正してください。
'////////////////////////////////////ここから
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
Cancel = True
With Worksheets("出荷案内")
.Unprotect
.Range("D20").Value = Target.Value
.Protect
Application.Goto .Range("D20")
End With
End Sub
'////////////////////////////////////ここまで
(5)通常の印刷ボタンでする場合は、以下のコードをThisWorkbookモジュールに貼り付けてください。
'////////////////////////////////////ここから
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name <> "出荷案内" Then Exit Sub
Set Sh1 = Worksheets("受注")
Set Sh2 = Worksheets("出荷案内")
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MyR = "わっけわっからん・・"
Else
Application.Goto Sh1.Range("G" & MyR)
Sh1.Range("F" & MyR).Value = "P"
End If
MsgBox MyR & "行目が印刷されます。" & vbCrLf & _
"受注№は " & MyNo & " です。"
End Sub
'////////////////////////////////////ここまで
(6)複数台のプリンターの中で、決まったプリンターで印刷したいってことでしょうか。
どのマクロに登録するのでしょうか。
最初の印刷ボタン？ あとの標準の印刷ボタン？
（川野鮎太郎）
素早い返事、有難うございます。
以下、質問＆お願いです。(やる前に聞くと怒られるかな････｡)
1)勉強になりました。初歩的なことをお聞きしてすみません。
2),3)了解しました。
4)これは、sheet"出荷案内"セルD20の保護設定対応だと思いますが、印刷したとき"P"と表示させるためのsheet"受注"F列(G列も保護有り)の保護設定対応も含むのでしょうか？
5)現在、印刷ボタン用のマクロはModule1に登録されています。
これを書き換えると言うことでしょうか？それともModule2に登録するのですか？
6)この項追加
印刷指示時に、一旦 "この内容で印刷していいですか？" と表示させ、｢OK｣ボタンクリックで印刷実行させたいのですが、どうすれば？
<印刷の補足説明>
印刷ボタンで印刷するよう担当者に案内するのですが、OSの印刷機能(ファイル→印刷)とやってしまった場合の"P"表示対策です。
OS標準の印刷機能を使用した場合はプリンターの設定はOS上で出来てるはずですから印刷指示でのプリンター指示は不要ですが、sheet"受注"Fxへの"P"表示対応が必要ということです。
複数台プリンターの件、担当によっては部屋が違うため夫々の部屋のプリンターを使用します。よって、MyPrint1,MyPrint2,MyPrint3,･････のように個別マクロを作成し、それらをModule1,Module2,Module3･････に登録の上、プリンターに対応した印刷ボタンを複数個用意したいのです。
従って、これら複数の印刷指示用マクロの中にOSでのプリンター名称を組み込みたいと言うことですが、可能なのでしょうか？
説明がうまくありませんが、伝わったでしょうか？宜しくお願いします。(Kuro)
ファイルメニューの左にあるエクセルのマークを右クリックして、コードの表示 出てきたThisWorkbookモジュールにコードを貼り付けてください。
（川野鮎太郎）
度々すみません。何度かやってるうちに、印刷実行後(マクロ印刷ボタン、OS標準
印刷共)、画面がsheet"受注"になってFxへ"P"表示する前に、sheet"出荷案内"の
セルD20をDeleteする必要が出てきました(印刷してるうちはいいのですが、何れ
ダイレクトにFAX送信となった際に、間違って再送信しないよう)。
申し訳ありませんが対応出来るでしょうか。お願いばかりで、本当に申し訳あり
ません。宜しくお願い申し上げます。(Kuro)
少し意味が判りません。 印刷すると、Pの表示がされるようにしていますよね。
そのPが表示される前に、D20を消しておくってことは、印刷しようとしたときには すでに消されているので、D20には何も無い状態で印刷しなければならないってことになりませんか。
（川野鮎太郎）
確かにそうですね。
要するに、いつまでもsheet"出荷案内"のセルD20に入力されていると、ハンドでsheet"出荷案内"に行った際に間違ってボタンを押しちゃうと、再度FAX(現在はプリンターですが、何れFAX)が送信されてしまうのを防止したかったのです。
これをやろうとすると、マクロでシートを行ったりきたりになりますので取りやめます。
すみません、あと、以下お教え下さい。
(現状でも十分ではあるのですが、出来ることなら･････｡)
4)これは、sheet"出荷案内"セルD20の保護設定対応だと思いますが、印刷したとき"P"と表示させるためのsheet"受注"F列(G列も保護有り)の保護設定対応も含むのでしょうか？
6)印刷指示時に、一旦 "この内容で印刷していいですか？" と表示させ、｢OK｣ボタンクリックで印刷実行させたいのですが、どうすれば？
7)複数台プリンターの件、担当によっては部屋が違うため夫々の部屋のプリンターを使用します。よって、MyPrint1,MyPrint2,MyPrint3,･････のように個別マクロを作成し、それらをModule1,Module2,Module3･････に登録の上、プリンターに対応した印刷ボタンを複数個用意したいのです。
従って、これら複数の印刷指示用マクロの中にOSでのプリンター名称を組み込みたいと言うことですが、可能なのでしょうか？
お手数をお掛けして申し訳ありませんが、宜しくお願いします。(Kuro)
こちらでは、どんなプリンターを使われているか判りませんので、個別に書くことは出来ませんが、
作成したボタンで印刷するコードには、プリンターの指定がありません。（無いってことは、デフォルト：通常使うプリンター）
ですから、違う人の部屋では、当然その部屋にあるプリンターがデフォルトだと思うので、
以下のような確認ではどうでしょうか。
Sub MyPrint()
Set Sh1 = Worksheets("受注")
Set Sh2 = Worksheets("出荷案内")
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "D20セルは不正な値です。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("プリンターは確認しましたか。" & vbCrLf & _
"現在のプリンターは " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受注№は、 " & MyNo & " です。", vbYesNo, "プリンターと内容の確認") = vbYes Then
Sh2.PrintOut
Application.Goto Sh1.Range("G" & MyR)
With Sh1
.Unprotect
.Range("F" & MyR).Value = "P"
.Protect
End With
MsgBox MyR & "行目が印刷されました。" & vbCrLf & _
"受注№は " & MyNo & " です。"
End If
End If
End Sub
作成したボタンで印刷するコードを使う場合は、ThisWorkbookに貼り付けたコードは削除しておいてください。
（川野鮎太郎）
お世話になります。
お手数をお掛けしていますが、おかげさまで完成間近です。
以下、お教え下さい。
1)印刷ボタンとOSの印刷機能の併用(Module1とThisWorkbookの双方にVBA入力)しておきどちらも使用可能には出来ないのでしょうか？
2)現在、sheet"受注",sheet"出荷案内"の保護設定にパスワードをかけています。このため、Gx右クリックと印刷ボタンクリックでパスワード入力が必要です。保護設定解除のパスワードをVBAに組み込むことは出来ないのでしょうか。
VBA内コードでパスワードが"****"となり、VBAコードを見ただけではパスワードが不明ならBestですが、それが不可能なら、VBAコードにパスワードを見える形で入力でも構いません。
3)間違って誰かがVBAコードを変更しないように、VBAシートの保護設定は出来ないのでしょうか？
あと一歩となりました。以上、宜しくお願い申し上げます。(Kuro)
↑追記；1)は、勿論、双方ともセルFxに"P"入力(表示)の上で。(Kuro)
少しはご自分で試したほうが良いですよ。 (1)両方のコードを残してやってみたら判ります。 (2)VBAのヘルプでProtectを調べれば判ります。 (3)VBAのツール＞VBAProjectのプロパティで設定できます。
（川野鮎太郎）
すみません、日程が決まっていたものですから、甘えてしまいました。
以下は、その後、色々やってみた結果です。
1)この、二つのVBAが競合を起こすのでしょうか、うまくいきませんでした。
何か方法が無いものかと思ったのですが････。
2)VBAコードで、.Unprotect (******),.Protect (******)として実行しましたが(******はパスワード)、パスワードが違うと蹴られます。実際は、そのパスワードでシートの保護の解除が可能なのに･････。何が悪いのでしょうか？
現在、同一のパスワードで、BookとSheetの保護設定をしています。これが原因かと思い、Bookの保護を解除し、Sheetの保護のみにしましたが同じです。大文字･小文字も間違っていません。何が悪いのでしょうか？
3)わかりました。有難うございました。
以上、2)の件、宜しくお願いします。(Kuro)
申し訳ないです。上記で書いたThisWorkbookモジュールのコードは破棄してください。
Workbook_BeforePrint のイベントでは、印刷が最後になるので、
受注シートを参照させた後で印刷されるので、印刷用のシートが印刷されませんね。
ボタン限定でのマクロだと思ってください。
受注シートを表示させないでよければ、ThisWorkbookモジュールのコードの
Application.Goto Sh1.Range("G" & MyR)を削除すれば併用可能です。
パスワードのものは以下のような感じです。
Sub MyPrint()
Set Sh1 = Worksheets("受注")
Set Sh2 = Worksheets("出荷案内")
Const MyPass As String = "AYU" '←ここでパスワードを定数宣言
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "D20セルは不正な値です。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("プリンターは確認しましたか。" & vbCrLf & _
"現在のプリンターは " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受注№は、 " & MyNo & " です。", vbYesNo, "プリンターと内容の確認") = vbYes Then
Sh2.PrintOut
Application.Goto Sh1.Range("G" & MyR)
With Sh1
.Unprotect Password:=MyPass '←ここ
.Range("F" & MyR).Value = "P"
.Protect Password:=MyPass '←ここ
End With
MsgBox MyR & "行目が印刷されました。" & vbCrLf & _
"受注№は " & MyNo & " です。"
End If
End If
End Sub
（川野鮎太郎）
お世話になっています。
その後試行錯誤の結果、OS標準印刷と印刷をボタン併用したいので、以下のように
してみました。
先ず、印刷ボタンで印刷指示した場合、ThisWorkbookモジュールで設定してある
確認文が表示されるということは、印刷ボタンで指示するとModule1のコード "Sh2.PrintOut"でThisWorkbookのコードに行き、それが完了後Module1に戻り、"Sh2.PrintOut"以降を実行して終了と言うことですよね？
あまり自信はないのですが、上記より以下のコードで実行してみました。
＜Module1＞
Sub MyPrint()
Set Sh1 = Worksheets("受注管理")
Set Sh2 = Worksheets("出荷案内")
Const MyPass As String = "******"
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
Else
Sh2.PrintOut
Application.Goto Sh1.Range("G" & MyR)
Sh1.Unprotect Password:=MyPass
Sh1.Range("F" & MyR).Value = "P"
Sh1.Protect Password:=MyPass
MsgBox "受注受付No. " & MyNo & " が印刷されました。"
End If
End Sub
＜ThisWorkbook＞
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name <> "出荷案内" Then Exit Sub
Set Sh1 = Worksheets("受注管理")
Set Sh2 = Worksheets("出荷案内")
Const MyPass As String = "******"
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受注受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在のプリンターは " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受注受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"印刷していいですか？", vbYesNo, "プリンターと内容の確認") = vbYes Then
Sh1.Unprotect Password:=MyPass
Sh1.Range("F" & MyR).Value = "P"
Sh1.Protect Password:=MyPass
End If
End Sub
＜実行結果＞
OS標準の印刷では、印刷内容確認Msgも出て、"P"も入力され、完了します。
ところが、印刷ボタンで実行すると、途中でエラー表示して止まるのでデバッグをやってみると、
Sh1.Range("F" & MyR).Value = "P"の部分が黄色く表示されています。
これって、"P"の入力が実行できないと言うことでしょうから、保護が解除されていないと
言うことですよね？
でも、OS標準印刷では全て完了するし、よくわかりません。
何が問題なのでしょうか？
度々申し訳ありませんが、宜しくお願いします。（Kuro)
標準の印刷でも2回目以降はPの入力が出来ないのじゃないですか。
上記のコードを直して見ましたので、確かめてみてください。 ただし、Passwordの部分は "******"ではなく、ちゃんとした "Kuro" などとしてください。
（川野鮎太郎）
お世話になります。
・標準の印刷だと、何度でもOKです。意図したように動作します。
・しかし、Module1で印刷ボタンで実行すると、デバッグの結果から見ると、ThisWorkbookの Sh1.Range("F" & MyR).Value = "P" でとまってしまいます。
どうしてでしょう？印刷ボタンと標準の印刷を併用するのは無理なのでしょうか？
併用をあきらめるしかない？何とか解決したいのですが･････。(Kuro)
これでどうでしょうか。
ThisWorkbookモジュール
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name <> "出荷案内" Then Exit Sub
Set Sh1 = Worksheets("受注管理")
Set Sh2 = Worksheets("出荷案内")
Const MyPass As String = "AYU"
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受注受付No.が違います。"
Else
If Sh1.Range("F" & MyR).Value = "P" Then Exit Sub
MyPrinter = Application.ActivePrinter
If MsgBox("現在のプリンターは " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受注受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"印刷していいですか？", vbYesNo, "プリンターと内容の確認") = vbYes Then
Sh1.Protect userInterfaceOnly:=True, Password:=MyPass
Sh1.Range("F" & MyR).Value = "P"
End If
End If
End Sub
標準モジュール
Sub MyPrint()
Set Sh1 = Worksheets("受注管理")
Set Sh2 = Worksheets("出荷案内")
Const MyPass As String = "AYU"
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受注受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在のプリンターは " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受注受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"印刷していいですか？", vbYesNo, "プリンターと内容の確認") = vbYes Then
Application.Goto Sh1.Range("G" & MyR)
Sh1.Protect userInterfaceOnly:=True, Password:=MyPass
Sh1.Range("F" & MyR).Value = "P"
Sh2.PrintOut
MsgBox "受注受付No. " & MyNo & " が印刷されました。"
End If
End If
End Sub
（川野鮎太郎）パスワード解除が出来てなかったので保護の方法を変えました。
返事が遅くなり申し訳ありません。
上記マクロで実行し、出来ました！感激です！
OSの標準印刷で実行すると標準の印刷確認画面が出るので、印刷ボタンでの印刷を徹底して実施に移します。
長らくお手数をお掛けしました。なんと御礼を言えばいいやら･･･。
本当に有難うございました。(Kuro)
こちらに統合しました。 （kazu）
『鮎さん、続き！Sheet3で二つのイベントプロシージャ(と言うのかな？)』（Kuro）
1)Sheet1で、C列のセルを右クリックすると、”受付”と文字入力。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 3 Then Exit Sub
Cancel = True
Target.Value = "受付"
End Sub
2)Sheet2で、E列のセルを右クリックすると、日付(当日)を入力。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Value = (Date)
End Sub
以上は、うまく動作します。
ところが、Sheet3で上記のC列とE列の両方をやろうとすると、エラーとなります。
同一シートのマクロで、二つの Private Sub・・・・
が有るので競合を起こしてるのだと思います(そうですか？)。
で、ひとつの Private Sub・・・・の下に、サブルーチンで二つの
Sub
End Sub
を入れましたが、うまくいきません。
初歩的質問で申し訳有りませんが、宜しくお願いします。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column = 3 Then
Cancel = True
Target.Value = "受付"
End If
If Target.Column = 5 Then
Cancel = True
Target.Value = (Date)
End If
End Sub
これでどうですか（kohe)
本題の回答はkoheさんが書いておられるので良いですけど、 題名に ＞鮎さん、続き！Sheet3 などと書かれても・・・ 私が常に見ているわけでもありませんし、名指しで聞かれると、 他の方の回答が得られにくくなり、Kuroさん自身が損しますよ(^_^A;
（川野鮎太郎）
鮎さん＞その節は、色々とお世話になりました。指摘の件、気をつけます。
koheさん＞有難うございます。出来ました。冷静になれば、なるほどです。
どうして気付かなかったんだろう。頭が固くなりかけてるのかも････｡
最初うまくいかなかったので、すぐにサブルーチンと考えてしまいました。
でも、サブルーチンでうまくいかないのも悔しいので、サブルーチンの場合はどうすればいいのでしょう？ (kuro)
koheさんのコードを使わせていただけば以下のような感じでしょうか。
Public MyTarget As String
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 3 And Target.Column <> 5 Then Exit Sub
Cancel = True
MyTarget = Target.Address
If Target.Column = 3 Then
Call 受付
End If
If Target.Column = 5 Then
Call 日付
End If
End Sub
Sub 受付()
Range(MyTarget).Value = "受付"
End Sub
Sub 日付()
Range(MyTarget).Value = Date
End Sub
条件が多い場合は、Select Caseで分ける方法もわかり易いかもしれません。
Public MyTarget As String
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 3 And Target.Column <> 5 Then Exit Sub
Cancel = True
MyTarget = Target.Address
Select Case Target.Column
Case 3
Call 受付
Case 5
Call 日付
End Select
End Sub
（川野鮎太郎）
鮎さん、ありがとうございます。
文字や日付等、8列ほどあるので、サブルーチンでやることにしました。また、Caseの方がスマートなのですが、個人的趣味でIf－End Ifでマクロにし完成しました。
ところで、以前のマクロを少し変えたところ問題が出てしまいました(以下です)。
＜従来＞
Sub 案内印刷()
Set Sh1 = Worksheets("管理")
Set Sh2 = Worksheets("案内")
Const MyPass As String = "kuro"
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Application.Goto Sh1.Range("G" & MyR)
Sh1.Protect userInterfaceOnly:=True, Password:=MyPass
Sh1.Range("F" & MyR).Value = "F"
Sh2.PrintOut
MsgBox "受付No. " & MyNo & " が送信されました。" & vbCrLf & vbCrLf & _
"ファイルを保存して終了してください。"
End If
End If
End Sub
上記で問題なく使用していたのですが、ファイルの保存も楽にしようと以下のように変更しました。
＜変更後＞
Sub 案内印刷()
Set Sh1 = Worksheets("管理")
Set Sh2 = Worksheets("案内")
Const MyPass As String = "kuro"
MyNo = Sh2.Range("D20").Value
MyR = Application.Match(MyNo, Sh1.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Application.Goto Sh1.Range("G" & MyR)
Sh1.Protect userInterfaceOnly:=True, Password:=MyPass
Sh1.Range("F" & MyR).Value = "F"
Sh2.PrintOut
If MsgBox("受付No. " & MyNo & " が送信されました。" & vbCrLf & vbCrLf & _
"ファイルを保存し、終了していいですか？", vbYesNo, "終了の確認") = vbYes Then
ActiveWorkbook.Close SaveChanges:=True
End If
End If
End If
End Sub
すると、変更内容は保存されるものの、保護が解除された状態で保存されます。
従来は、保護設定されて保存されます。また、変更後も"ファイルを保存して終了してください。" で"いいえ"を選択すると、保護設定された状態です。ここからファイル→保存とすれば可能ですが、これでは意味がありません。
使用上は、"ファイルを保存し、終了していいですか？"で"はい"、"いいえ"の両方(別作業継続と作業終了の両方)のパターンがあります。
Sh1.Protect userInterfaceOnly:=True, Password:=MyPass のところかなという気もしますが、終了しなければ保護設定されていますし････｡ 尚、従来・変更後共、ThisWorkbookには従来と同一のコードが入っています。
何が原因で、どう対処すればいいのでしょう？ (Kuro)
標準モジュールに以下のコードを入れてください。
Sub Auto_Open()
Const MyPass As String = "kuro"
Worksheets("案内").Protect userInterfaceOnly:=True, Password:=MyPass
Worksheets("管理").Protect userInterfaceOnly:=True, Password:=MyPass
End Sub
それと、 Sub 案内印刷()内の Const MyPass As String = "kuro" と Sh1.Protect userInterfaceOnly:=True, Password:=MyPass を削除 シートモジュールの右クリックイベント内の .Unprotect と .Protect の行を削除
VBAのヘルプでProtectメソッドの説明があります。
解説
引数 UserInterfaceOnly に True を設定した Protect メソッドをブックのワークシートに適用した場合、 保存して閉じた後でもう一度開いたブックに対しては、画面上からもマクロからも変更ができなくなります。 マクロからの変更を可能にするためには、引数 UserInterfaceOnly に True を設定した Protect メソッドを再び適用する必要があります。
（川野鮎太郎）
このBook内にある他のシートも、同一パスワードで保護設定してあります。
この場合、
Sub Auto_Open()
Const MyPass As String = "kuro"
ActiveWorkbook.Protect userInterfaceOnly:=True, Password:=MyPass
End Sub
を標準モジュールに入れておけばいいのでしょうか？ (Kuro)
案内シートと管理シート以外にもマクロで編集したりしているならば、
Sub Auto_Open()
Const MyPass As String = "kuro"
Worksheets("案内").Protect userInterfaceOnly:=True, Password:=MyPass
Worksheets("管理").Protect userInterfaceOnly:=True, Password:=MyPass
Worksheets("●●").Protect userInterfaceOnly:=True, Password:=MyPass ←ここに追加してみてください。
End Sub
上記の件、面倒なので1行で済まないかと ActiveWorkbookとか ThisWorkbook とかやっていましたがそんな構文はないようで不可能でした。
(VBAProjectのパスワードは違うので、Book全体では2種類のパスワードでした！)
よって、アクセスするシート名を全て記載するようにしました。
別件です。
以下のことをやろうとして、うまくいきません。
1)sheet"商品リスト"で商品番号を右クリック。
受注可能商品の商品番号はA列にあります。
2)sheet"管理"に移動し、新規受付行の商品番号欄に1)で選択した商品番号を入力。
商品番号入力欄はN2:N501で、受付の度にN2から順に入力します。 下記マクロで列Nの既入力セル最下行直下セルに入力するよう指示したつもりですがうまくいきません。 .Range(MyR).Value = Range(MyTarget).Value のところで引っかかるようです。
＜sheet"商品リスト"＞
Public MyTarget As String
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
Cancel = True
MyTarget = Target.Address
If Target.Column = 1 Then
Call 商品番号入力
End If
End Sub
Sub 商品番号入力()
If Range(MyTarget).Value = "" Then Exit Sub
With Worksheets("管理")
Range(MyR) = Range("N501").End(xlUp).Offset(1).Select.Address
.Range(MyR).Value = Range(MyTarget).Value
Application.Goto .Range(MyR)
End With
End Sub
又、上記は、sheet"管理"で商品番号欄に自動入力の場合ですが、シート移動後自動入力ではなく列Nのダブルクリックしたセルに入力する場合はどのようにすればいいのでしょう？ (他の項目で、sheet"管理"に移動した後入力判断し、入力せずに終了する場合がある項目用です。)
昨夜、本を見ながらやってましたがどうもうまくいきません。
よろしくお願いします。（Kuro)
最初の質問は、以下のようにしてください。
Public MyTarget As String
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
Cancel = True
MyTarget = Target.Address
If Target.Column = 1 Then
Call 商品番号入力
End If
End Sub
Sub 商品番号入力()
If Range(MyTarget).Value = "" Then Exit Sub
With Worksheets("管理")
MyRange = Range("N501").End(xlUp).Offset(1).Address
.Range(MyRange).Value = Range(MyTarget).Value
Application.Goto .Range(MyRange)
End With
End Sub
2番目の質問は以下にしてください。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 14 Then Exit Sub
Cancel = True
Target.Value = Application.InputBox("商品番号を入力してください。", "商品番号の入力", Type:=3)
End Sub
'///////////////////
＞Range(MyR) = Range("N501").End(xlUp).Offset(1).Select.Address
＞.Range(MyR).Value = Range(MyTarget).Value
上記のコードは使い方が間違っています。
まず、
Range(MyR) = Range("N501").End(xlUp).Offset(1).Select.Addressの部分ですが、
MyRの変数が無い セレクトとアドレスのプロパティが同時に書いてある。
私の書いたものと良く見比べてみてください。
（川野鮎太郎）
すみません。
1)1番目回答は、二つのコード共シート"商品リスト"に入れるんですよね。
2)2番目の質問は、1番目と同様にシート"商品リスト"で入力したい商品番号を右クリックしたら、マクロでシート"管理"に移動し、そこで列Nの任意のセルをダブルクリックしたら前に選んだ商品番号(右クリックした商品番号)が選択したセル(ダブルクリックしたセル)に入力される。と言うことです。
多分鮎さんの2番目の回答は、シート"管理"で単独に動作し、マニュアルで商品番号を入力する場合だと思うのですが･････｡
また、右クリックした商品番号セルの2つ右のセル内容を、自動入力(又はダブルクリックで選択)したセルより3つ右のセルに同時に入力するにはどうすれば？(Offsetを使うんですよね？)
鮎さん指摘の箇所はこれからよく見てみます。(今すぐは出来ないので、後で･･･。)
色々と勉強になります。有難うございます。本当は本を手にじっくり時間をかけて、もっと自分で検討しないといけないのですが、日程も有るものですから････。
初心者ですがこれからも宜しくお願いします。(Kuro)
両方とも商品リストのシートモジュールに貼り付けます。
商品番号入力コードは、Offsetも追加しましたので、以下に変えてください。
Sub 商品番号入力()
If Range(MyTarget).Value = "" Then Exit Sub
With Worksheets("管理")
MyRange = .Range("N501").End(xlUp).Offset(1).Address
.Range(MyRange).Value = Worksheets("商品リスト").Range(MyTarget).Value
.Range(MyRange).Offset(0, 3).Value = Worksheets("商品リスト").Range(MyTarget).Offset(0, 2).Value
Application.Goto .Range(MyRange)
End With
End Sub
2番目の回答は単独も何も、管理シートでダブルクリックしたときイベントなので 書いたとおりです。
（川野鮎太郎）
返事が遅くなりすみません。
シート"商品リスト"で右クリックしてシート"管理"に自動入力は出来ました。
2番目の質問内容が伝わらなかったようなので、もう一度説明させてもらいます。
ここでやりたかったことは、一連の操作で、
1)シート"商品リスト"で右クリック 2)シート"管理"で商品番号セルをダブルクリック
3)すると、シート"管理"のダブルクリックセルに商品番号商品番号を入力、及びそれに付随するデータが同一行の所定列に自動入力。ということです。
言い換えれば、シート"商品リスト"のイベントプロシージャ内に、更に(シート"管理"に移動後の)イベントプロシージャを書くような感じです。
或いは、シート"商品リスト"のイベントプロシージャ完了後に移動したシート"管理"イベントプローシージャがその前に右クリックした商品番号を引き継ぐような感じですが、
これは無理なんでしょうね？
可能であれば、上記前者が出来ればと思うのですが････。原理的に無理なのかな？？？
お教え下さい。(Kuro)
少し動作に矛盾がありませんか。
＞1)シート"商品リスト"で右クリック ←これは、すでに出来てますよね。 ＞2)シート"管理"で商品番号セルをダブルクリック ←これは私が書いてますよね。 ただし、セルに直接入力するには保護の解除やなにやらで複雑になりそうなので インプットボックスで入力するようにしてますが。
＞3)すると、シート"管理"のダブルクリックセルに商品番号商品番号を入力、及びそれに付随するデータが同一行の所定列に自動入力
1)で右クリックしたセルの値が入った管理シートのセルを再度ダブルクリックする必要があるのでしょうか。
右クリックしたセルの値が入った管理シートのセルに付随するデータを自動入力するだけなら 右クリックイベントの中に、そのまま入れれば良いだけですよ。
（川野鮎太郎）
すみません。説明不足だったようです。
シート"管理"では、受付Noに対し入力する項目が数箇所あります。この数箇所の入力をVBAで行うのですが、受付担当者の中には不明な箇所を後で入力する人も出そうです。
そこで、1)の自動入力のVBAでは各項目の最終行に入力するため、上記のように全項目に入力されていない受付データが有ると、次回の入力が本来の受付Noの行に入力されない自体が発生します。そこで自動入力ではなく、セルをダブルクリックしその行に入力したい。と言うことです。
従って、
1)シート"商品リスト"内の右クリックで、その行の必要データを記憶(？)してシート"管理"に移動。 2)シート"管理"でダブルクリックし、ダブルクリックしたセル及びその行の(Offsetで指示した)適切な列のセルにデータを自動入力。としたいと言うことです。
インプットBOXへの入力は、操作者(受付担当)がシート"商品リスト"で選択した商品番号を入力する。と言うことですよね？
今気付きましたが、インプットBOXでダブルクリックすると、商品番号及びOffsetで指示したデータが同一行に入力されると言うこと？
又、2番目の下記コードは、シート"管理"に入れるのですよね？
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 14 Then Exit Sub
Cancel = True
Target.Value = Application.InputBox("商品番号を入力してください。", "商品番号の入力", Type:=3)
End Sub
すみません、説明、理解度とも悪くて･････。
上記、教えてください。宜しくお願いします。(kuro)
>If Target.Count > 1 Then Exit Sub これは複数のセルを選択してWクリックしたら下のコードを実行せずに終了しなさいっ っちゅう事ですワ。
>If Target.Column <> 14 Then Exit Sub Columnとは列の事でしてナ、シートの左端から数えて１４番目、つまりN列以外でWクリ ックしたばやい、その時点でこのコードを終了しなさいという意。
>Cancel = True どこかのセルを選択してＷクリックしたらどないなります？そう、編集モードになりま んなぁ。kuroはんがやりたいんはセルの編集で無うてマクロの実行でっしゃろうから このイベントは不要っちゅうか、むしろ邪魔になりますわなぁ。 勿論、>Cancel=Trueを書かんでも実行するようにはなってますけど、カーソルがチカチ カして目障りやさかいここに限ってそれは止めてんかという意味ですワ、えぇ。
>Target.Value = Application.InputBox("商品番号を入力してください。", "商品番号の入力", Type:=3)
Application.InputBoxの間にカーソルを合わせてＦ１キーを叩いたら詳細な説明が載っ
てますけど、要するにそのInputBoxに入力したデータがTargetのデータになりますよと
いう意味ですワ。
こんなとこで手ぇ打ってもらえまっか？
（弥太郎）
ー---------------
＞弥太郎さん、説明有難うございます。弥太郎さんの言われてることはほぼ分かってるつもりなのですが･････。
このInputBoxへの入力を自動orクリックのみでやりたいと言うことなのですが･････。
人が覚えておいて再入力とかコピー＆ペイストしたくないというか、
キーボードで入力したくないと言うか、
そういうことなのですが無理なのでしょうね？ (Kuro)
あ、そうか、あのヘルプにゃ載ってまへんでしたわなぁ。 あの、これはそのセル（目的のセル）をアクティブにしてクリックしたらええっちゅう コードでっせぇ。つまりあんさんの仰有るクリックのみで用を果たしてくれまんねんけ ど。意味がちゃいまっか？ '------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Value = Application.InputBox("商品番号を入力してください。", "商品番号の入力", Type:=3)
MsgBox Target
End Sub
テストテスト 上のコードを新しいブックにコピペして任意のセルを選択、仮にＡ１へKuroとでも入力 しとってくらはい。 任意のセルで（A1以外）Ｗクリックしますとinputboxがでますさかい、inputboxへ 入力せずにセル（A1)をクリックしてみておくんなはれ。どうでっか？ あんさんのご希望通りになりまへんか？ わたしゃ勘違いしとんのやろか？ （弥太郎）
弥太郎さん、フォローありがとうございます。ペコ(o_ _)ｏ))
私も勘違いしているのかな・・・。 kuroさんのおっしゃる意味が理解できません＿/￣|○ il||li
出来れば、管理シートと商品リストのシートのセル配置とデータをかいていただいて、 どこをどうしたときに、どのような結果になりたいか、具体的に書いてみていただけませんでしょうか。
出来れば、実際のファイルを以下のramrunさんのサーバーにアップしていただければありがたいです。 もちろん、実在する人物、企業名等は省略したもので結構です。 プロパティ内の作成者名等も削除しておいてください。 http://ryusendo.no-ip.com/cgi-bin/upload/upload.html
（川野鮎太郎）
お邪魔します。
途中は全然みていません。見ようとしましたが、ちょっと気力がありませんでした。
なので↓ここだけに限定です。
1)シート"商品リスト"内の右クリックで、その行の必要データを記憶(？)してシート"管理"に移動。
2)シート"管理"でダブルクリックし、ダブルクリックしたセル及びその行の(Offsetで指示した)適切な列のセルにデータを自動入力。
標準モジュールに
Option Explicit
Public MyData As Variant
Public MyFlag As Boolean
右クリック（記憶する？）するシートモジュールに
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
MyFlag = True
MyData = Target.Resize(, 5).Value '今はA列からE列までにしています。適当に変更してください。
End Sub
ダブルクリック（転記する）するシートモジュールに
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Column <> 1 Then Exit Sub
If MyFlag Then
Target.Resize(, 5).Value = MyData
MyFlag = False
End If
End Sub
どうでしょうか？
と回答してからいうのも何ですが、、これって
コピーして貼り付けですよね？？？？(^^;
全然勘違いしてましたら、ごめんちゃいです。m(__)m
（SoulMan）
皆様、ありがとうございます。私の説明が下手なため、かえって混乱を招いてるような気がしました。
SoulManさんが言われるように、単純にいえば、シート"商品リスト"で選択した商品データの、シート"管理"で選択した受付No行所定セルへのコピーということになります。
具体的に言うと、
1)シート"商品リスト"で商品番号(ex.セルA5)を右クリックする。
2)シート"管理"の受付No(ex.セルG8)をダブルクリックする。
すると、
・シート"商品リスト"のセルA5→シート"管理"のセルG8 にコピー貼り付け
・シート"商品リスト"のセルA6→シート"管理"のセルG9 にコピー貼り付け
・シート"商品リスト"のセルA7→シート"管理"のセルG11 にコピー貼り付け
・シート"商品リスト"のセルA10→シート"管理"のセルG12 にコピー貼り付け
ということです。
また、既にVBA標準モジュールに入ってるコードとの競合等も心配です。(そんなことってあるのかもよく知らない初心者ですが･････)。
SoulManさんのコードは、Option Explicit で始まっていますが、Option Explicit なしで、現在ある Private Sub Worksheet_BeforeRightClick 以下に入れるとまずいのでしょうか？
今、肝心のFileが手元にないので詳細が書けないのですが････。後日、改めて現状コードも含め、再度UPします。(とりあえず、上記質問教えてください。)
私の説明と理解度が悪く申し訳ありませんが、よろしくお願いします。（Kuro)
>既にVBA標準モジュールに入ってるコードとの競合等も心配です。 変数なので標準モジュールの先頭に記述します。 Option Explicit のすぐ下です。 >現在ある Private Sub Worksheet_BeforeRightClick 以下に入れるとまずいのでしょうか？ すみません。あまりというかぁ、、全然みてませんのでなんとも言えません。とりあえず 最初は、新規Bookでテストしてから実際のBookに応用されるのがいいでしょう。 新規BookのSheet1とSheet2に適当なデータを入れてお試しください。 あせらずに頑張ってくださいね。ではでは、 （SoulMan）
おっ、ありゃりゃマクロの登場でんな。（笑 Kuroはん、私も長い道中は見てまへんさかい、あんさんの質問のみに回答したんですけ ど、今年の最長スレとして最後までやりとげまひょうで。 切れモンのご両人が受け持ってくれたら解決せんことはおまへんで、ホンマ。 ほなら、わたしゃ傍観者っちゅうことで・・・（弥太郎）（笑
すみません。根気がないのでやっぱりこれまでのレスは見れません^^;
なので↓これだけに限定です。後は適当に応用してください。
具体的に言うと、
1)シート"商品リスト"で商品番号(ex.セルA5)を右クリックする。
2)シート"管理"の受付No(ex.セルG8)をダブルクリックする。すると、
シート"商品リスト"のセルA5→シート"管理"のセルG8 にコピー貼り付け
シート"商品リスト"のセルA6→シート"管理"のセルG9 にコピー貼り付け
シート"商品リスト"のセルA7→シート"管理"のセルG11 にコピー貼り付け
シート"商品リスト"のセルA10→シート"管理"のセルG12 にコピー貼り付け
標準モジュールは同じで
右クリックするシートモジュールに
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
MyFlag = True
MyData = Target.Resize(3).Value
MyData = Application.Transpose(MyData)
ReDim Preserve MyData(1 To UBound(MyData) + 1)
MyData(UBound(MyData)) = Target.Offset(5).Value
MyData = Application.Transpose(MyData)
End Sub
ダブルクリックするシートモジュールに
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim j As Long
Cancel = True
If MyFlag Then
For i = 1 To UBound(MyData, 1)
If i = 3 Then j = j + 1
Target.Offset(j).Value = MyData(i, 1)
j = j + 1
Next
MyFlag = False
End If
End Sub
で一応
あ5
あ6
あ7 あ10 こうなりました。ではでは、おやすみなさいzzzzzzzzzzzzzzzz （SoulMan）
誠に申し訳ありません。昨日は全く飛んだ間違いを記入してしまいました。(手元にFileがなく書いてたので･･･)。本当にすみません。
鮎さん＞教えていただいたところへのUPが難しそうです。検討しますが今しばらく現状で････。
Soulmanさん＞気力で、最初から読んで頂ければ･････(勝手なことを、すみません。)
昨日の質問の修正版を再記入しますと、
1)シート"商品リスト"で商品番号(ex.セルA5)を右クリックする。
すると、マクロでシート"管理"に移動。(ここは鮎さんの指導で完成済み)
2)シート"管理"の受付No(ex.セルN8)をダブルクリックする。
シート"管理"の7行迄は入力済みとすると、
・シート"商品リスト"のセルA5→シート"管理"のセルN8 にコピー貼り付け
・シート"商品リスト"のセルB5→シート"管理"のセルO8 にコピー貼り付け
・シート"商品リスト"のセルC5→シート"管理"のセルP8 にコピー貼り付け
ということです。
質問1)
この場合、Soulmanさんのコードはどうなるの････？
上記は以前説明したように、受付担当者が入力必須項目を全箇所入力しない場合があるため、次回の入力セルが同一行に入力されないことの対策としてダブルクリックにより入力行を指定させたいためです。(同一行に入力されない理由は、下記コード参照)
現在のコードは、
<シート"商品リスト">
Public MyTarget As String
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
Cancel = True
MyTarget = Target.Address
If Target.Column = 1 Then
Call 商品番号入力
End If
End Sub
Sub 商品番号入力()
If Range(MyTarget).Value = "" Then Exit Sub
With Worksheets("管理")
MyRange = .Range("N501").End(xlUp).Offset(1).Address
If .Range(MyRange).Offset(0, 1).Value <> "" Then Exit Sub
If .Range(MyRange).Offset(0, 2).Value <> "" Then Exit Sub
.Range(MyRange).Value = Worksheets("商品リスト").Range(MyTarget).Value
.Range(MyRange).Offset(0, 1).Value = Worksheets("商品リスト").Range(MyTarget).Offset(0, 1).Value
.Range(MyRange).Offset(0, 2).Value = Worksheets("商品リスト").Range(MyTarget).Offset(0, 2).Value
Application.Goto .Range(MyRange)
End With
End Sub
でその後考えた結論は、やはり受付担当が必須項目を入力していないことを許容すること自体まずいので、シートを終了する前にチェックを入れ、必須項目全部を入力していない場合はシートの終了ができないようにすべきと。
ここでまた問題発生です。
質問2)
以下のコードを ThisWorkbook に入れたのですがエラーとなります。原因は何でしょう？
<ThisWorkbook>
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
If Range(MyRange).Rows <> Sh4.Range("N501").End(xlUp).Offset(1).Rows Then
Call 受付入力エラー
Cancel = True
End If
If Range(MyRange).Rows <> Sh4.Range("O501").End(xlUp).Offset(1).Rows Then
Call 受付入力エラー
Cancel = True
End If
If Range(MyRange).Rows <> Sh4.Range("P501").End(xlUp).Offset(1).Rows Then
Call 受付入力エラー
Cancel = True
End If
End Sub
Sub 受付入力エラー()
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日･受付者･商品番号･商品名欄に入力ください。", vbOKOnly + vbExclamation, "受付入力エラー"
End Sub
質問3)
上記コードでIf･･･Thenの3つを次のようにひとつに纏めてもいいのでしょうか？
If Range(MyRange).Rows <> Sh4.Range("N501").End(xlUp).Offset(1).Rows Then
If Range(MyRange).Rows <> Sh4.Range("O501").End(xlUp).Offset(1).Rows Then
If Range(MyRange).Rows <> Sh4.Range("P501").End(xlUp).Offset(1).Rows Then
Call 受付入力エラー Cancel = True End If
質問4)
また、BeforeClose を BeforeSave でやろうとすると、イベントプロシージャとコードが一致していないというようなエラーMsgがでます。 BeforeSave で実行するにはどうすれば？
もう一点。今、Moduleには以下のコードがあります。
<Module1>
Sub Auto_Open()
Const MyPass As String = "Kuro"
Worksheets("管理").Protect userInterfaceOnly:=True, Password:=MyPass
Worksheets("案内").Protect userInterfaceOnly:=True, Password:=MyPass
End Sub
Sub 案内印刷()
Set Sh4 = Worksheets("管理")
Set Sh6 = Worksheets("案内")
MyNo = Sh6.Range("D20").Value
MyR = Application.Match(MyNo, Sh4.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Application.Goto Sh4.Range("G" & MyR)
Sh4.Range("F" & MyR).Value = "F"
Sh6.PrintOut
If MsgBox("受付No. " & MyNo & " が送信されました。" & vbCrLf & vbCrLf & _
"ファイルを保存し、終了していいですか？", vbYesNo, "終了の確認") = vbYes Then
ActiveWorkbook.Close SaveChanges:=True
End If
End If
End If
End Sub
質問5)
上記コード内に、ActiveWorkbook.Close SaveChanges:=True と設定していますので、
ここにも前記 ThisWorkbook と同様な必須項目入力確認を入れる必要がありますよね？ すなわち、Module内の保存･終了コードは、ThisWorkbook 内の入力確認に引っ掛からない(パスしてしまう)のですか？
質問6)･･･追加質問
質問ばかりですみません。こんなことで少しずつでも上達するものでしょうか？
じっくり本で勉強しないと、とは思いながら、時間がなくて････。
以上、よろしくお願い申し上げます。（Kuro)
>気力で、最初から読んで頂ければ･････(勝手なことを、すみません。)
すみません。無理です。(^^;
一番大切なことはKuroさんが解決することですよ。
今回も↓この部分に限ってお答えします。
というよりも最初に既にお答えしてますけどね。それを応用されたらいいんですけど、、
回答者も勉強しなくてはいけませんが、Kuroさんも質問上手にならないとね(^^;
>1)シート"商品リスト"で商品番号(ex.セルA5)を右クリックする。
>すると、マクロでシート"管理"に移動。(ここは鮎さんの指導で完成済み)
>2)シート"管理"の受付No(ex.セルN8)をダブルクリックする。
>・シート"商品リスト"のセルA5→シート"管理"のセルN8 にコピー貼り付け
>・シート"商品リスト"のセルB5→シート"管理"のセルO8 にコピー貼り付け
>・シート"商品リスト"のセルC5→シート"管理"のセルP8 にコピー貼り付け
ということで、
標準モジュールは同じで
右クリックするシートモジュールに
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
MyFlag = True
MyData = Target.Resize(, 3).Value
End Sub
ダブルクリックするシートモジュールに
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If MyFlag Then
Target.Resize(, 3).Value = MyData
MyFlag = False
End If
End Sub
こちらでは一応確認済みです。新規Bookにデータを入力してお試しください。
ではでは、
（SoulMan）
SoulManさん、有難うございます。
昨夜、あれからやってみました。その結果、上記質問の2)3)4)は却下し以下に変更させて下さい。これだけに限定で結構ですから、下記質問宜しくお願いします。
(回答する方がわかりよいように気をつけます。)
1)終了の前に、入力データが間違い無いかのチェックを以下で入れました。
<ThisWorkbook>
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
If Range(MyRange).Row = Sh4.Range("I501").End(xlUp).Offset(1).Row And _
Range(MyRange).Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then Exit Sub
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日・受付者・商品番号・商品名称・メーカー名 " & vbCrLf & _
"･特約店コード・特約店名欄に入力ください。", vbOKOnly + vbExclamation, "受付入力エラー"
Cancel = True
End Sub
すると、これはOKです。
ところが、チェック項目を増やすと(例えば下記のように)、実行されません。
If Range(MyRange).Row = Sh4.Range("I501").End(xlUp).Offset(1).Row And _
Range(MyRange).Row = Sh4.Range("N501").End(xlUp).Offset(1).Row And _
Range(MyRange).Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then Exit
同考えても、原因がわかりません。何が原因？
2)上記チェックを保存時に行おうと以下にしました。
<ThisWorkbook>
Private Sub Workbook_BeforeSave(Cancel As Boolean)
以下同
すると、｢プロシージャ宣言が、イベント又はプロシージャの定義と一致しません｣とMsgがでます。この意味は？又、どうすればいいのでしょう？
上記1),2)限定で結構ですからご教示お願いします。(Kuro)
提示されたコードを元に二つパターンを作ってみましたのでお試しください。
Option Explicit
'これがOKなら
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
If Range(MyRange).Row = Sh4.Range("I501").End(xlUp).Offset(1).Row And _
Range(MyRange).Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then Exit Sub
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日・受付者・商品番号・商品名称・メーカー名 " & vbCrLf & _
"･特約店コード・特約店名欄に入力ください。", vbOKOnly + vbExclamation, "受付入力エラー"
Cancel = True
End Sub
'これで動きます。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
If Range(MyRange).Row = Sh4.Range("I501").End(xlUp).Offset(1).Row Then
If Range(MyRange).Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
If Range(MyRange).Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
Exit Sub
End If
End If
End If
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日・受付者・商品番号・商品名称・メーカー名 " & vbCrLf & _
"･特約店コード・特約店名欄に入力ください。", vbOKOnly + vbExclamation, "受付入力エラー"
Cancel = True
End Sub
'条件を増やしたいのなら↓にされた方がわかりやすくないですか？
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
With Range(MyRange)
If .Row = Sh4.Range("I501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
Exit Sub
End If
End If
End If
End With
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日・受付者・商品番号・商品名称・メーカー名 " & vbCrLf & _
"･特約店コード・特約店名欄に入力ください。", vbOKOnly + vbExclamation, "受付入力エラー"
Cancel = True
End Sub
>回答する方がわかりよいように気をつけます。
頑張ってる人にはどんどん応援したくなります。
こちらこそよろしくお願い致します。v(=∩_∩=)v
（SoulMan）
お世話になっています。
SoulManさんのコードやってみましたが、私のコードの場合と同様でした。
つまり、
Close時に、所定のセルに入力されてるかをチェックし、未記入列が有るとMsg表示のコードなのですが、3項目(3列)ならOKですが4項目(4列)以上だと、未記入セルは無いのにMsg表示がでてClose出来ません。
具体的には、I列空欄最上行＝N列空欄最上行 And I列空欄最上行＝O列空欄最上行 ならClose、はOKですが、これにもうひとつ、I列空欄最上行＝P列空欄最上行 ならCloseとなるよう項目を増やすと未記入セルは無いのにMsgが出てしまいます。
どう考えてもここのコード自体の問題では無いようにも思いますが、原因は何でしょう？
推測でも結構です。宜しくお願いします。（Kuro)
どうも最初の
With Range(MyRange)
If .Row = Sh4.Range("I501").End(xlUp).Offset(1).Row Then
これは結局、I列空欄最上行？？
>I列空欄最上行＝N列空欄最上行
>I列空欄最上行＝O列空欄最上行
>ならClose、はOKですが、これにもうひとつ、
>I列空欄最上行＝P列空欄最上行 ならCloseとなるよう項目を増やすと
>未記入セルは無いのにMsgが出てしまいます。
を整理して
'Range(MyRange)がI列空欄最上行だとするなら、、
With Range(MyRange)
If .Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("P501").End(xlUp).Offset(1).Row Then
Exit Sub
End If
End If
End If
End With
こうじゃないでしょうか？？（ちょっと自信なし(^^;）
ブレイクポイントを設定しながら確認してくださいね。
（SoulMan）
↑のコードは、前回SoulManさんが書いたのと同じですよね・・・。勿論前回のSoulMan
さんのコードもやってみましたがだめでした。
今夜、もう一度トライしてみます。今度は他のコードを全てなくして、Closeのコードのみで確認してみます。(Kuro)
>↑のコードは、前回SoulManさんが書いたのと同じですよね・・・。
違いますよ。
前回のコード
With Range(MyRange)
If .Row = Sh4.Range("I501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
Exit Sub
End If
End If
End If
End With
今回のコード
With Range(MyRange)
If .Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("P501").End(xlUp).Offset(1).Row Then
Exit Sub
End If
End If
End If
End With
です。
結局、デバックはご自身で一つ一つ確認されることが大切です。
Excelくんは正直ですから、そこには必ず原因があるはずです。
ブレイクポイントを活用してください。
（SoulMan）
>ブレイクポイントを活用してください。
所々にMsgBoxを入れて確認するのも有効です。
With ActiveSheet
With .Range("i65536").End(xlUp).Offset(1)
If .Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
MsgBox "同じです"
If .Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
MsgBox "同じです"
If .Row = Sh4.Range("P501").End(xlUp).Offset(1).Row Then
MsgBox "同じです" & Chr(13) & _
"抜けます"
Exit Sub
End If
End If
End If
End With
End With
または、見方を変えて全部書き出してみるとか・・・
MsgBox "I列は" & ActiveSheet.Range("I65536").End(xlUp).Offset(1).Row
MsgBox "N列は" & Sh4.Range("N501").End(xlUp).Offset(1).Row
MsgBox "O列は" & Sh4.Range("O501").End(xlUp).Offset(1).Row
MsgBox "P列は" & Sh4.Range("P501").End(xlUp).Offset(1).Row
（SoulMan）
検証の結果、
・コードの書き方は、条件を And で続けても、If&End If で複数にしても問題なし。
結局、判明したのは以下です。(最終行に全て入力されていても)
別のシートから各列のデータを転記させているのですが、直接指定したデータは問題なし。 問題は、転記時に指定したセルに対しOffset で転記させたデータを確認条件に入れるとだめです。(Offset命令コードは↑に載っています)
どうしてこうなるのでしょう？Offsetであろうとマクロで転記した後は単なる文字列なのだと思うのですが････？ それとも転記のOffset命令がまずいのか････｡ でもOffsetでの転記そのものには何も問題が無いのですけど････。
理由が分れば、教えてください。 (Kuro)
簡単なサンプルを作ってみましたのでお試しください。
先ず、A1に
=IF(B1<>"",1,"")
と入力して下に適当にコピーします。
B列に適当に何かを入力します。
するとB列に何かがある場合は「1」が立ちますよね？
その状態で↓を実行してみてください。
Option Explicit
Sub てすと()
Dim MyArea As Areas
MsgBox "数式は " & Range("A65536").End(xlUp).Row & " まで入力されています"
Set MyArea = Sheets("Sheet1").UsedRange.SpecialCells(xlCellTypeFormulas, 1).Areas
MsgBox "B列には、" & MyArea.Item(MyArea.Count).Offset(MyArea.Item(MyArea.Count).Rows.Count - 1).Row & " まで入力されています"
End Sub
数式の中の""は空白ではないですよ。文字数ゼロの文字なのです。
どうでしょうか？
（SoulMan）
今、以下のようになっています。(少し長くなりますが、ご容赦の程)
シート”管理”は、H列；受付日、I列；受付者、N列；商品番号、O列；商品名称を入力。
シート”商品リスト”は、A列；商品番号、B列；商品名称 のリスト。
シート”商品リスト”から シート”管理”に転記するコード、及び、終了時の入力チェックコードは以下です。
<シート"商品リスト">
Public MyTarget As String
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
Cancel = True
MyTarget = Target.Address
If Target.Column = 1 Then
Call 商品番号入力
End If
End Sub
Sub 商品番号入力()
If Range(MyTarget).Value = "" Then Exit Sub
With Worksheets("管理")
MyRange = .Range("N501").End(xlUp).Offset(1).Address
If .Range(MyRange).Offset(0, 1).Value <> "" Then Exit Sub
.Range(MyRange).Value = Worksheets("商品リスト").Range(MyTarget).Value
.Range(MyRange).Offset(0, 1).Value = Worksheets("商品リスト").Range(MyTarget).Offset(0, 1).Value
Application.Goto .Range(MyRange)
End With
End Sub
<ThisWorkbook>
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
If Range(MyRange).Row = Sh4.Range("I501").End(xlUp).Offset(1).Row And _
Range(MyRange).Row = Sh4.Range("N501").End(xlUp).Offset(1).Row And _
Range(MyRange).Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then Exit Sub
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日・受付者・商品番号・商品名称欄に入力ください。", vbOKOnly + vbExclamation, "受付入力エラー"
Cancel = True End Sub
これより分るように、シート間の転記はエクセル関数ではなくマクロで実行しています。
と言うことは、Offset での転記内容は単なる文字列でしかないと思うのですが、どうして正しく入力確認が不可能なのでしょうか？
と言うより、マクロ実行せず、データは全く未入力(1行目列見出しは有る)の状態でもClose出来ません。不可解です。
又、従来はエクセル関数のOffsetを使用して入力確認していました。
この場合、商品番号はマクロで転記させますが商品名はエクセル関数のOffsetですから、
商品名の列は501行まで全て数式が入っていますが終了時の入力確認マクロは正常に動作します。
じゃあ、エクセル関数のOffsetでやればとなりますが、それでは商品名が変更になった場合等、過去の受付データまで変更され具合が悪いのです。
どうしてなんでしょう？？？(Kuro)
ちょっと長くなってしまったので同じBookを持ってお話しましょう。
とりあえず作ってみましたのでこれであってますか？
それからちょっと気になるところは直しています。
全体に変数の宣言をちゃんとしないとだめです。
それから、親オブジェクトをしっかりと明示しないと予測出来ないトラブルの原因となります。
これらは基本ですから最初から身に付ける様にしましょう。
標準モジュールに
Option Explicit
Public MyTarget As String
商品リストモジュールに
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
Cancel = True
MyTarget = Target.Address
Call 商品番号入力
End Sub
Sub 商品番号入力()
Dim MyRange As String
If Range(MyTarget).Value = "" Then Exit Sub
With Worksheets("管理")
MyRange = .Range("N501").End(xlUp).Offset(1).Address
If .Range(MyRange).Offset(0, 1).Value <> "" Then Exit Sub
.Range(MyRange).Value = Worksheets("商品リスト").Range(MyTarget).Value
.Range(MyRange).Offset(0, 1).Value = Worksheets("商品リスト").Range(MyTarget).Offset(0, 1).Value
Application.Goto .Range(MyRange)
End With
End Sub
Thisworkbookモジュールに
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Sh4 As Worksheet
Dim MyRange As String
Set Sh4 = Worksheets("管理")
MyRange = Sh4.Range("H501").End(xlUp).Offset(1).Address
Application.Goto Sh4.Range(MyRange)
With Worksheets("管理")
With .Range(MyRange)
If .Row = Sh4.Range("I501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("N501").End(xlUp).Offset(1).Row Then
If .Row = Sh4.Range("O501").End(xlUp).Offset(1).Row Then
Exit Sub
End If
End If
End If
End With
End With
MsgBox "受付入力必須項目が未入力です。" & vbCrLf & vbCrLf & _
"受付日・受付者・商品番号・商品名称欄に入力ください。", _
vbOKOnly + vbExclamation, "受付入力エラー"
Cancel = True
End Sub
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0328.xls
右クリックして保存してください。
（SoulMan）
お世話になっています。
有難うございます。初心者に教えるのは大変とは思いますが、宜しくお願いします。
なんと御礼を言っていいやら･･････。(お叱りも含め、勉強になります。)
SoulManさんに頂いたシートで実行したら、出来ました。
でも教えていただいた(↑)コードを作成中のシートで実行したら、やはり前回と同様に、マクロOffsetで持ってきた列を入力確認に入れると、入力されていてもCloseできません。
教えていただいたのと同様に、他のシートにも変数定義したのですが・・・・？？？
まだ、どこか悪いのでしょうか？(もう少しトライしてみる予定ですが、お気付きの点や
怪しそうな箇所がありましたら教えてください)
実は、もう一点問題が発生しました。印刷用コードがエラーとなってしまいます。
印刷に関連のコードは以下です。(シート”案内”印刷ボタン有)
<Module1>
Option Explicit
Public MyTarget As String
Sub Auto_Open()
Const MyPass As String = "Kuro"
Worksheets("管理").Protect userInterfaceOnly:=True, Password:=MyPass
Worksheets("案内").Protect userInterfaceOnly:=True, Password:=MyPass
End Sub
Sub 案内印刷()
Dim Sh4 As Worksheet
Dim Sh6 As Worksheet
Dim MyNo As String
Dim MyR As Variant
Dim MyPrinter As String
Set Sh4 = Worksheets("管理")
Set Sh6 = Worksheets("案内")
MyNo = Sh6.Range("D20").Value
MyR = Application.Match(MyNo, Sh4.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Application.Goto Sh4.Range("G" & MyR)
Sh4.Range("F" & MyR).Value = "F"
Sh6.PrintOut
If MsgBox("受付No. " & MyNo & " が送信されました。" & vbCrLf & vbCrLf & _
"ファイルを保存し、終了していいですか？", vbYesNo, "終了の確認") = vbYes Then
ActiveWorkbook.Close SaveChanges:=True
End If
End If
End If
End Sub
<ThisWorkbook>
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Sh4 As Worksheet
Dim Sh6 As Worksheet
Dim MyNo As String
Dim MyR As Variant
Dim MyPrinter As String
Set Sh4 = Worksheets("管理")
Set Sh6 = Worksheets("案内")
MyNo = Sh6.Range("D20").Value
MyR = Application.Match(MyNo, Sh4.Columns(7), 0)
If ActiveSheet <> Sh6 Then Exit Sub
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
If Sh4.Range("F" & MyR).Value = "F" Then Exit Sub
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Sh4.Range("F" & MyR).Value = "F"
End If
End If
End Sub
1)上記で印刷を実行すると、ThisWorkbook の If ActiveSheet <> Sh6 Then Exit Sub の行で止まり、
”オブジェクトは、このプロパティ又はメソッドをサポートしていません”と出ます。
どうすればいいのでしょうか？
2)上記コードのうち、以下はこれでいいのでしょうか？
・Dim MyPrinter As String (←不要？)
・Dim MyNo As String
・Dim MyR As Variant
3)その他、間違い箇所等ありましたら指摘をお願いします。
宜しくお願いします。（Kuro)
なんやようわからんです。(×_×;）
コードからだけで判断してるんで、、勘違いでしたらごめんちゃいねm(__)m
それよりもそろそろ手打ちにしませんか？(^^;
Option Explicit
Public MyTarget As String
Sub Auto_Open()
Const MyPass As String = "Kuro"
Worksheets("管理").Protect userInterfaceOnly:=True, Password:=MyPass
Worksheets("案内").Protect userInterfaceOnly:=True, Password:=MyPass
End Sub
Sub 案内印刷()
Dim Sh4 As Worksheet
Dim Sh6 As Worksheet
Dim MyNo As String
Dim MyR As Variant
Dim MyPrinter As String
Set Sh4 = Worksheets("管理")
Set Sh6 = Worksheets("案内")
MyNo = Sh6.Range("D20").Value
MyR = Application.Match(MyNo, Sh4.Columns(7), 0)
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Application.Goto Sh4.Range("G" & MyR)
Sh4.Range("F" & MyR).Value = "F"
Sh6.PrintOut Preview:=True
If MsgBox("受付No. " & MyNo & " が送信されました。" & vbCrLf & vbCrLf & _
"ファイルを保存し、終了していいですか？", vbYesNo, "終了の確認") = vbYes Then
ActiveWorkbook.Close SaveChanges:=True
End If
End If
End If
End Sub
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Sh4 As Worksheet
Dim Sh6 As Worksheet
Dim MyNo As String
Dim MyR As Variant
Dim MyPrinter As String
Set Sh4 = Worksheets("管理")
Set Sh6 = Worksheets("案内")
MyNo = Sh6.Range("D20").Value
MyR = Application.Match(MyNo, Sh4.Columns(7), 0)
If ActiveSheet.Name <> Sh6.Name Then Exit Sub
If IsError(MyR) Then
MsgBox "受付No.が違います。"
Else
If Sh4.Range("F" & MyR).Value = "F" Then Exit Sub
MyPrinter = Application.ActivePrinter
If MsgBox("現在の送信先は " & MyPrinter & " です。" & vbCrLf & vbCrLf & _
"受付No.は " & MyNo & " です。" & vbCrLf & vbCrLf & _
"送信していいですか？", vbYesNo, "送信先と内容の確認") = vbYes Then
Sh4.Range("F" & MyR).Value = "F"
End If
End If
End Sub
（SoulMan）
有難うございます。すみません。でも、あと、もう一歩です。
ここで SoulMan さんに見放されると･･････。(もう少しお願いします。)
・Module1 に Sh6.PrintOut Preview:=True を入れる。
・ThisWorkbook で If ActiveSheet.Name <> Sh6.Name Then Exit Sub に変更。
ということですよね。
でも、
・ThisWorkbook で Sub kkk() の意味がわかりません。一つしかないし･･･。
これは、どういう意味なんでしょう？
・ThisWorkbook には、Sh6.PrintOut Preview:=True は要らないんですよね？
誠に申し訳ありません。よろしくお願いします。(Kuro)
あわわわわあっわあわ、、、単なる消し忘れです。（￣□￣；）！！ デバックするのにいちいち印刷出来ませんのでね(^^; >は要らないんですよね？ いらないと思います。 ということで、、お手をはいしゃくぅ～～！よぉ～～ぱんぱん！！！ なんちゃって （SoulMan）
お待たせっ！ いよぉ～～ぱんぱん！！！ なんて････。
ありがとうございました。ほぼ解決しました。例のマクロOffset列の終了確認は未だに未解決ですが、Offset列を確認列から外しました。
まだ全て完成した訳ではないので、今後また質問するかも知れませんが、取り敢えずこのスレッドはこれで終わりにしたいと思います。
問題が発生したら、別スレ立てますのでその際はよろしくお願いします。
(ヤダヨなんて言わないでね！)
何人もの方にお世話になりました。
鮎さん、SoulManさん、弥太郎さん、その他の方々、本当にありがとうございました。
なんとお礼を言っていいか分かりません。
「こうやってみんな成長するんだよ」と言ってもらえれば、幸いです。
(私もいつか、人の役に立てれば、と思うこの頃です。)
今後とも、よろしくお願いします。(Kuro)
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.