Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


218 / 3841 ページ ←次へ | 前へ→

【78089】Re:VBAで「リンク貼り付け」をしたい
発言  マナ  - 16/4/2(土) 10:43 -

引用なし
パスワード
   ▼かな さん:
毎回、シートを作り直しています。
シート名が不適切でエラーとなる場合もあるかもしれません。

Sub シート分け2()
  Dim ws As Worksheet
  Dim n As Long
   Dim h As Range
  
  With Worksheets("一覧表")
    Application.DisplayAlerts = False
    For Each ws In Worksheets
      If ws.Name <> .Name Then ws.Delete
    Next
    Application.DisplayAlerts = True
    
    n = .Range("A1").CurrentRegion.Columns.Count
    
    '転記する
    For Each h In .Range("H7:H" & .Range("H65536").End(xlUp).Row)
      Set ws = Nothing
      On Error Resume Next
      Set ws = Worksheets(h.Value)
      On Error GoTo 0
      If ws Is Nothing Then
        '支店名シートを新調する
        Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        ws.Name = h.Value
        .Rows(1).Resize(, n).Copy ws.Range("A3")
      End If
      ws.Range("H65536").End(xlUp).EntireRow.Resize(, n).Offset(1).Formula = _
        "=" & h.EntireRow.Range("A1").Address(False, False, , True)
      
    Next
  End With

End Sub
・ツリー全体表示

【78088】Re:ブックの複製禁止
発言  γ  - 16/4/2(土) 8:34 -

引用なし
パスワード
   解決したようで、何よりです。

>質問に対し
> >水を差すわけではありませんが
>との的を外れた返信を頂き、
> >訂正すべきところをお教えください。
>に対して
> >私の見解は、コメントした通りですが
> >なぜ、ByVal を指定したのですか?
>との(私にしてみれば)再び的外れと感じた返信を頂いたので
>言葉が過ぎた返信をいたしました。

少しも的外れではないと思いますよ。
>プロシージャの宣言が、イベントまたはプロシージャの定義と
>  一致していません。
というエラーメッセージをキチンと読んでいれば、
なぜ、ByVal を指定したのですか?
という確認の意味を理解できるはずですね。

また、水を差すようですが、ということでの指摘も、
より広い範囲での留意点を述べられたもので、
これも参考として受け止めて欲しい有益な指摘だったと思います。
色々な視点からの指摘も活かせるような受け答えを勉強されると、
よろしいかと老婆心ながら思いました。
頑張ってくださいね。
・ツリー全体表示

【78087】Re:複数図を選択して、グループ化するマ...
発言  マナ  - 16/4/1(金) 19:58 -

引用なし
パスワード
   ▼urupis さん:

activesheet.shapes.range(shapename).select

これで、どうなりますか?
・ツリー全体表示

【78086】Re:VBAで「リンク貼り付け」をしたい
質問  かな  - 16/4/1(金) 19:08 -

引用なし
パスワード
   ご回答、ありがとうございます。
質問内容を変えてしまって、大変すみませんでした。

考えていたところ、私が必要としていたのが「リンク貼り付け」だったので。

ご教授いただいたコードの雛形は、
「ActiveSheet.Paste Link:=True」なのかと思いますが、
これを今のコードの中でどこを変更すればよいのかが分かりません。

初心者ですみません。
・ツリー全体表示

【78085】Re:VBAで「リンク貼り付け」をしたい
発言  β  - 16/4/1(金) 18:52 -

引用なし
パスワード
   ▼かな さん:

先ほどは、「値貼り付け」だったので、回答案をメモっていたら、取り消されて
「リンク貼り付け」になりましたね。

ある行をコピー ---> 別の行のA列を選択して 貼り付けで リンク貼り付け。
これをマクロ記録すると、お望みのコード雛形が生成されますよ。
・ツリー全体表示

【78084】VBAで「リンク貼り付け」をしたい
質問  かな  - 16/4/1(金) 18:22 -

引用なし
パスワード
   VBAで困っているところがあるので質問します。

下記VBAを検索で見つけ、使用したいと思っているのですが、
これを「リンク貼り付け」に変えるにはどうしたら良いでしょうか?

よろしくお願いします。


Sub シート分け()
 Dim h As Range
 On Error GoTo errhandle
 Worksheets("一覧表").Select

'転記する
 For Each h In Range("H7:H" & Range("H65536").End(xlUp).Row)
  h.EntireRow.Copy Worksheets(h.Value).Range("A65536").End(xlUp).Offset(1)
 Next
 Exit Sub

errhandle:
'支店名シートを新調する
 Worksheets.Add after:=Worksheets(Worksheets.Count)
 ActiveSheet.Name = h.Value
 Worksheets("一覧表").Range("1:1").Copy Range("A3")
 Resume
End Sub
・ツリー全体表示

【78083】複数図を選択して、グループ化するマクロ...
質問  urupis  - 16/4/1(金) 17:50 -

引用なし
パスワード
   こんにちは。初めまして。
urupisと申します。

複数図を選択して、グループ化するマクロを作成の困っているので
ご指南いただきたいと思い投稿いたしました。

■実装したい内容
マニュアル作成にあたり、
スクリーンキャプチャした図に対して赤枠の図などで囲ったりします。
選択したすべての図の上に図形などが存在した場合は、
それを自動的にグループ化をしたいです。

以下のように図の上に図が存在するかを特定することが
私の調べた範囲ではできなかったので、
選択範囲を指定して、その枠内に図形がある場合は名前を取得するところまではできたのですが、
このあとどうグループ化をしていけばわかりません。
実装したい内容が実現できるマクロを教えていただけますでしょうか。
ご指南のほどよろしくお願いします。

Sub 選択されているセル範囲内の図形をグループ化する()

 Dim shp As Shape
 Dim rng_shp As Range
  Dim shapeName() As String
  Dim i As Long

  If TypeName(Selection) <> "Range" Then Exit Sub
  i = 0
  For Each shp In ActiveSheet.Shapes
 
     ''図形の配置されているセル範囲をオブジェクト変数にセット
    Set rng_shp = Range(shp.TopLeftCell, shp.BottomRightCell)
     ''図形の配置されているセル範囲と
    ''選択されているセル範囲が重なっているときに図形の名前を取得
    If Not (Intersect(rng_shp, Selection) Is Nothing) Then
      ReDim Preserve shapeName(i)
      shapeName(i) = shp.Name
      i = i + 1
    End If
  Next

  'Selection.ShapeRange.Group.Select
End Sub
・ツリー全体表示

【78081】Re:ブックの複製禁止
お礼  gg57  - 16/4/1(金) 10:55 -

引用なし
パスワード
   γさま
 >不明な点を尋ねる、知っている方がコメントする。
 >それだけのことではないですか?
確かにおっしゃるとおりです。

質問に対し
 >水を差すわけではありませんが
との的を外れた返信を頂き、
 >訂正すべきところをお教えください。
に対して
 >私の見解は、コメントした通りですが
 >なぜ、ByVal を指定したのですか?
との(私にしてみれば)再び的外れと感じた返信を頂いたので
言葉が過ぎた返信をいたしました。

γさまの
 >普通、イベントプロシージャの引数はさわらないとしたものですが、
のような単純かつ適切な回答がいただきたかっただけです。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Cancel = False
 Application.DisplayAlerts = False
 Application.Quit
 Application.DisplayAlerts = True
End Sub

で解決いたしました。
ありがとうございました。
・ツリー全体表示

【78080】Re:ブックの複製禁止
発言  γ  - 16/4/1(金) 7:45 -

引用なし
パスワード
   ▼gg57 さん:
>初心者であるからです。
>
>>上記コードをみて下記コードを試してみましたが
>
>"もっと自分で調べて上級者になってから質問して来い"
>と言われるならそうします。
>
>初心者には敷居の高い質問サイトのようですね。
>
>失礼いたしました。

おっしゃる意味がわかりかねますね。
普通、イベントプロシージャの引数はさわらないとしたものですが、
なぜ変更したのか、特別の意図があるのですか?
とβさんは単に質問しただけなのに、
初心者がどうのこうの、と言い出す意味がわかりません。
もう少し、フラットな気持ちで質問された方がよいと思いますよ。
不明な点を尋ねる、知っている方がコメントする。
それだけのことではないですか?
・ツリー全体表示

【78079】Re:ブックの複製禁止
発言  gg57  - 16/4/1(金) 7:29 -

引用なし
パスワード
   初心者であるからです。

>上記コードをみて下記コードを試してみましたが

"もっと自分で調べて上級者になってから質問して来い"
と言われるならそうします。

初心者には敷居の高い質問サイトのようですね。

失礼いたしました。
・ツリー全体表示

【78078】Re:ブックの複製禁止
発言  gg57  - 16/4/1(金) 7:24 -

引用なし
パスワード
   βさま
悪意のある操作に対応する質問ではありません。

>ブックを直接閉じても保存させないようにしたいのですが

読み取り専用でファイルを開いている(コピーできないと思って作業している)作業者の単純操作による混乱を防ぎたいというだけの話です。
・ツリー全体表示

【78077】Re:ブックの複製禁止
発言  β  - 16/3/31(木) 18:59 -

引用なし
パスワード
     ▼gg57 さん:

私の見解は、コメントした通りですが

Private Sub Workbook_BeforeClose(ByVal Cancel As Boolean)

なぜ、ByVal を指定したのですか?


・ツリー全体表示

【78076】Re:ブックの複製禁止
発言  β  - 16/3/31(木) 18:48 -

引用なし
パスワード
   ▼gg57 さん:

水を差すわけではありませんが、どんな構えをとったとしても
マクロ無効で開かれてしまえば、何も制御ができませんし
また、誰でも簡単にエクスプローラでファイルコピーできますし、
VBAを書くことができる人は、ファイルコピーのコードを書いて、
さくっとコピーしてしまいますよ、
・ツリー全体表示

【78075】ブックの複製禁止
質問  gg57  - 16/3/31(木) 17:59 -

引用なし
パスワード
   ブックの複製を禁止したいのです(EXCEL2013)。
(1)読み取りパスワードを設定している。"読み取りを推奨する"を設定している。
→読み取り専用で開いている。
(2)ファイル属性を"読み取り専用"に設定している。
(3)"名前を付けて保存"はVBAにて保存禁止としている。
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then
  MsgBox ("このファイルは名前を付けて保存できません")
  Cancel = True
  Application.Quit
  Application.DisplayAlerts = False
End If
End Sub

上記1〜3の条件の場合でも
×でブックを直接閉じようとすると
保存を確認するメッセージが表示され,保存ボタンを押すと
ブック名に"コピー"がついて保存ができてしまいます。

ブックを直接閉じても保存させないようにしたいのですが
上記コードをみて下記コードを試してみましたがだめでした。
****************************************************************
!コンパイルエラー:
  プロシージャの宣言が、イベントまたはプロシージャの定義と
  一致していません。
****************************************************************
Private Sub Workbook_BeforeClose(ByVal Cancel As Boolean)
 Application.Quit
 Application.DisplayAlerts = False
End Sub

訂正すべきところをお教えください。
・ツリー全体表示

【78074】Re:イベント処理について
発言  かず  - 16/3/27(日) 14:16 -

引用なし
パスワード
   ▼かず さん:
>▼かず さん:
>>▼β さん:

サンプルコードに誤字があったので修正しました。

4.サンプルコードの解説 (井川春樹さんの本から抜粋)

'*************************************************************
' 井川さんのサンプルコードの解説
'*************************************************************
では(1)から順に見ていきましょう。
 まず、1行目でEventステートメントを使ってイベントを宣言しています。このクラスは
Rowslnsertというイベントを発行して、そのイベントプロシージヤは、CancelというBoolean d
の引数を参照渡しで受け取りますよ、といった宣言になります。

CheckRowsInsertメソッドは、この後解説するタイマー処理によって繰り返し実行され、
行が挿入されたタイミングでイベントを発行するメソッドです。

ここで重要なのは、Static変数「myRow」が最終行を表すRangeオブジェクトへの参照を保持していることです。

初めて実行されるときだけは変数「myRow」が「Nothing」なので、その場合には最終行を
表すRange オブジェクトへの参照を格納するだけの処理を行いますが、2回目以降には
いよいよチェックを行います。

このチェックには、On Error Resume Nextステートメントを使って、実行時エラーを
無視するようにしてから、変数「myRow」に参照が格納されているRangeオブジェクトの
何らかのプロパティを取得してみるのが簡単です。

ここではRowプロパティを取得していますが他のプロパティでもかまいません。
このとき、行が挿入されていれば最終行は存在しなくなっているのでエラーが発生します。
ですから、「エラーの発生=行が挿入された」と判断できるわけです。エラーの発生の
有無はErr関数を使って参照を取得できるErrObjectオブジェクトのNumberプロパティ
で判断できます。

エラーが発生していなければNumberプロパティの値が「O」となるからです。
そして、行が挿入されたと判断したらRaiseEventステートメントを使ってRowslnsert
イベントを発行します。引数Cancelには変数[myCancel]を指定し、イペントプロシー
ジヤによって、変数.[myCancel」の値が「True」に変更される(引数Cancelに「True」
が設定される)と、ApplicationオブジェクトのUndoメソッドを使って、行挿入の操作
を元に戻します。

次に(2)のコードをご覧ください。これはタイマープロシージヤと呼ばれるプロシー
ジヤで、この後解説するWin32API関数のSetTimer関数の引数lpTimeerFuncにこのプロ
シージヤのアドレスを指定すると、繰り返し非同期で実行されるようになります。

宣言部については決まり事として覚えておいてください。ここで行っている処理は、
clsRowsInsertEventオブジェクトのCheckRowsInscrtメソッドを実行するといった
ものです。

clsRowsInsertEventオブジェクトへの参照は、?Bのコードで定義している
ThisWorkbookクラスのRowsInsertEventClassプロパティを使って取得します。

最後に(3)のコードの要点をまとめます。
まず、このブックモジュールでclsRowsInsertEventオブジェ列が発行するイベント
をハンドルするために、モジュールレベルのオブジェクト変数
「mvRowsInsertEventClass」を、WithEventsキーワードを付けて
、cIsRowsInsertEvent型で宣言します。

そして、そのclsRowsInsertEventオブジェ列のRowslnsertイペントプロシージャに、
行挿入時に実行する処理を記述します。ここでは、キャンセルするかどうかの
問い合わせのみを行っています。

タイマー処理の開始はブックのOpenイベントプロシージャで、終了はBeforeCloseイベント
ブロシージャで行います。

タイマー処理を開始するのはWin32API関数のSetTimerで、引数HwndとnlDEventには0を、
nElapseにはタイマー処理を実行する問隔(ミリ秒)を、lpTimerFunc にはタイマー
プロシージャのアドレスを指定します。プロシージャのアドレスはAddressOf演算子を
使って取得します。

なお、サンプルではnElapseに「O」を指定していますが、当然ですがOミリ秒ごとに処理
を繰り返すといった非現実的なことは不可能です。このような場合処理できる極めて
微小な時間単位で処理が繰り返されます。

SetTimer関数の戻り値はタイマーIDと呼ばれる識別子で、
KillTimer関数のnIDEventに指定することでタイマー処理を終了できます。
サンプルでは、ブックのBeforeCloseイベントプロシージャの処理に保存確認の
ロジックを内包しているのは、BeforeCloseイペントプロシージャの処理によって
タイマー処理(イベント発行のための監視)を完了してから、Excelの機能によって
保存確認が行われた場合にキャンセルすると、イベントをハンドルできない状態で
開かれたままになるからです。

さて(3)のコードの最後で定義しているRowsInsertEventClassプロパティの内容
はまったく難しいものではありません。モジュールレベル変数
[my RowsInsertE vent Class]が「Nothing」であれば新たにインスタンスを生成
してから、その参照を返すプロパティです。

しかし1つだけ重要なことがあります。
このようにして外部にclsRowsInsertEventオブジェクトヘの参照を返す(公開する)
場合には、clsRowsInsertEventクラスのInstancingがデフォルトのPrivate]のまま
ではいけないからです。

このような場合には、あらかじめ[プロパティ]ウインドウを使ってInstancingを
[PublicNotCreatable]に設定しておきます。

ポイント
タイマー処理中に実行時エラーが発生すると、Excelが即座に落ちてしまいます。
万が一にもそのようなことがないように、絶対に実行時エラーが発生しない処理
でない限り、必ずOn Error Resume Nextステートメントを付けるようにしましょう。
--
・ツリー全体表示

【78073】Re:イベント処理について
質問  かず  - 16/3/27(日) 14:15 -

引用なし
パスワード
   ▼かず さん:
>▼β さん:

質問を再度整理しました。
コピーしたセルの挿入時、挿入行の行番号
を把握するための方法について教えてください。

1.業務要件
(1)建設プロジェク(=案件と呼ぶ。)の案件名、担当社、売上、利益
 などを1行にまとめて月次でメンテしています

(2)大元のマスタリストがあり、それを月に一回、10人の担当者に配布。
担当者は自分の担当案件の追加や、案件の売上や利益の変化を、配布
された表に記載して返信。

(3)各担当から返信されたリストを大元のマスタに反映させています

2.担当者が案件情報をリストに反映する際の記載ルール

▼(更新):
リストの各行に対し変更ががある場合、行の1列目に▼印をつける。

 削除は行削除ではなく、案件の進捗を示すセルを用意して、
 失注として表す。リストの行の削除は考慮不要。

★(挿入):
リストに対し、案件=行を追加する場合1列目に★印をつけて、行
ごと追加する

2.ワークシートのイメージ

(1) 最初にマスタ側リスト作成時、リスト右端余白で今は使われていない
 部分に以下の作業列を追加

  列    作業列1  作業列2 作業列3

  番号   日時時刻   シーケンスNo 枝番
  A/1 (略) BL/64     BM/65  BN/66  現時点の枝番号の計算式
行  --------------------------------------------------------------------------------
10 &#9251; (略) 2016/3/26/ 18:23 1   1  =COUNTIF($BM$10:$BM709,BM10) 
11 &#9251;  略
12 &#9251;  略
13 ★ (単純な空行の挿入) ・&#9251;・  1  =COUNTIF($BM$11:$BM709,BM11)   
14 &#9251;
15 ・・ ・2016/3/26/ 18:23・・6・・1  =COUNTIF($BM$15:$BM15,BM15) (A)
16 ★・(15行目をコピー挿入)  6・・2  =COUNTIF($BM$16:$BM16,BM16) (A)
17 &#9251;  略
18 &#9251;  略
19 ★・(20行目をコピー挿入)・ 9・・2  =COUNTIF($BM$18:$BM709,BM18) (B)
20 &#9251;・・・・・・・・・・・・ 9・・2  =COUNTIF($BM$19:$BM709,BM19) (B) 
709 ・・・・・・・・・・・・・697・ 1  =COUNTIF($BM$10:$BM709,BM709)

【説明】
 行の挿入には、単純な空行の追加とコピーした行の挿入の2種類がある。
 どちらの場合も、井川はるき著 VBA裏ワザ大辞典Sample31_1のコードを
 参考にして行が挿入されたことは添付のコードで検知可能。

 業務要件から1列目に★印をつけたいが、コピー元はそのままで
 コピー先にだけ★印をつけたい。

 ⇒ 単純空行の挿入の場合は、本来はシーケンスNoとしているBM列に空白が
できるのでそこをFind文で探して 行番号を取得可能。
   
 ・ただしコピーして挿入の場合は、BM列の値は同じ値の行が複数できてしまう。
 BN列に枝番号や重複有無を示す計算式を入れる方法、(上記(A)(B)あるがいずれも
 うまくいかない)では重複していることはわかるがどの行が挿入されたかわからない。

 ・コピーして挿入なので タイムスタンプではコピー前とコピー後の区別がつかない
 
【質問事項】
 Q1 コピーした行を挿入のイベントが発生した場合に、イベント処理の中で
  どの行が挿入されたか枝番やタイムスタンプか、他の方法で特定する方法
  をご存知の方は教えてください。

 Q2 上記のイベント処理では、ブックを開いて閉じるまでのイベントをタイマ
  監視しているが何かの理由でイベントの監視ができなくなった場合、
  イベント処理をあきらめて手動でワークシートを記載してもらえればよい
  ようにするにはどうしたらよいでしょうか

  既定のイベントでは Application.EnableEvents = False を発行すれば
  イベントが発生しなくなるので、自作イベントでもそのようにするにはど
  すればいいいでしょうか?
 
  イベント監視処理は中止します。修正が終了したら1列目に▼や★を書くの
  を忘れず記入してくださいとメッセージがだせれば十分です。
 
3.イベントプロシジャを使うコード
  井川はるきさんおサンプルコードを一部改変して作成しました。
  私には少し難しい方法のようです

' 井川はるき さんのサンプルコード
' ★印の行は 投稿者 かずが改変した部分
’***************************************
' サンプル解説の?@ クラスモジュール clsRowsInsertEvent
' ***************************************
Public Event RowsInsert(Cancel As Boolean, InsRow As Long) ’★ InsRowを追加 by かず

Public Sub CheckRowsInsert(ByVal mySht As Worksheet)
Static myRow As Range
Dim myInsRow As Long     '★ 行を挿入した行番号を格納するための変数
Dim myCancel As Boolean
Dim w_FndRng As Range

Const TopRow As Integer = 29 '★ 作業列2の最初の行番号の
Const SeqCol As Integer = 65 '★ 作業列2の列番号
Const EdaNum As Integer = 66 '★ 作業列2 枝番を格納するための行
Dim i As Long         '★ 制御変数
  
If mySht Is Nothing Then Exit Sub

With mySht
 If Not myRow Is Nothing Then

  On Error Resume Next
  myInsRow = myRow.Row

  If Err().Number <> 0 Then 

  ’★単純な行の挿入の場合、SeqCol列の空白を探す
  Set w_FndRng = Range(Cells(TopRow, SeqCol), Cells(Rows.Count, SeqCol).End(xlUp)).Find("", , xlValues, xlWhole, xlByRows, xlNext) '★
  
  If Not w_FndRng Is Nothing Then ’★
    ' ★単純に行挿入された場合 SeqCol列は""空白のセルがある
    myInsRow = w_FndRng.Row   ' ★
  Else
    '★ コピーして挿入の場合、作業列2には元の行と同じ値が入る 
    i = TopRow            '★
    Do While (i < Rows.Count)    '★
      If Cells(i, EdaNum) > 1 Then '★
        myInsRow = i       '★
        Exit Do          '★
      End If            '★
      i = i + 1           '★
    Loop               '★
  End If                '★
        
  RaiseEvent RowsInsert(myCancel, myInsRow)
  If myCancel Then
     Application.Undo
  End If
 End If
 End If
 Set myRow = .Rows(.Rows.Count)
End With
End Sub

'***********************************************************
' ?A 標準モジュール
'***********************************************************
Sub TimerProc(ByVal Hwnd As Long, ByVal uMsg As Long _
  , ByVal idEvent As Long, ByVal dwTime As Long)
  On Error Resume Next
  ThisWorkbook.RowsInsertEventClass.CheckRowsInsert Sheet3 ’★引数Sheet3をかずの環境にあわせて設定
End Sub

’***************************************
' ?B ThisWorkbook
' ***************************************

Private Declare Function SetTimer Lib "user32" ( _
  ByVal Hwnd As Long, ByVal nIDEvent As Long _
  , ByVal uElapse As Long, ByVal lpTimerFunc As Long) _
  As Long
Private Declare Sub KillTimer Lib "user32" ( _
  ByVal Hwnd As Long, ByVal nIDEvent As Long)

Private WithEvents myRowsInsertEventClass As clsRowsInsertEvent
Private myTimerId As Long

Private Sub myRowsInsertEventClass_RowsInsert(Cancel As Boolean, myInsRow As Long)
  '
 '★ 作業列1 時刻取得して タイムスタンプをとる(予定)
 '★ 作業列2 シーケンシャル番号を格納する(予定)
  MsgBox myInsRow & "行に挿入されました" ’★ 現状 挿入行を確認するため MsgBoxを出力
  
  Cancel = MsgBox("行が挿入されました。" & vbCrLf _
    & "キャンセルしますか?", vbInformation Or vbYesNo) = vbYes
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim myRes As VbMsgBoxResult
  If Not Saved Then
    myRes = MsgBox("'" & Name & "' への変更を保存しますか?" _
      , vbExclamation Or vbYesNoCancel)
    If myRes = vbYes Then
      Save
    ElseIf myRes = vbNo Then
      Saved = True
    Else
      Cancel = True
      Exit Sub
    End If
  End If
  KillTimer 0&, myTimerId
  Set myRowsInsertEventClass = Nothing
End Sub

Private Sub Workbook_Open()
  myTimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub

Public Property Get RowsInsertEventClass() As clsRowsInsertEvent
  If myRowsInsertEventClass Is Nothing Then
    Set myRowsInsertEventClass = New clsRowsInsertEvent
  End If
  Set RowsInsertEventClass = myRowsInsertEventClass
End Property
・ツリー全体表示

【78072】Re:イベント処理について
回答  かず  - 16/3/27(日) 2:25 -

引用なし
パスワード
   ▼β さん:
>▼かず さん:
>
>>7)キーがマッチする行や挿入先の行が風名などの場合は
>風名 とは?

 申し訳ありません。風名ではなく不明でした。申し訳ありません。
 
言いたかったのは、以下の点です。

7)更新の場合に変更元とキーがマッチする行がマスターリストに存在しない
 挿入の場合に、更新元リストで挿入位置を示す行に該当する行が、マスター
 リストに存在しない等、イレギュラー状態の場合は、挿入対象行はマスター
 リストの一番最後の部分に挿入し、1列目にエラーの理由を書き込む。


>>サンプルコードの解説を補足します
>これを見るために、井川さんの書式を購入しなければいけないのですか?

サンプルコード(私が追記した部分は★印を記載

' 井川はるき さんのサンプルコード

’***************************************
' クラスモジュール clsRowsInsertEvent
' ***************************************
Public Event RowsInsert(Cancel As Boolean, InsRow As Long) ’★ InsRow を引数に追加 by かず

Public Sub CheckRowsInsert(ByVal mySht As Worksheet)
  Static myRow As Range
  Dim myInsRow As Long         ' ★ 行を挿入した行番号を格納するための変数
  Dim myCancel As Boolean
  Dim w_FndRng As Range
  Const TopRow As Integer = 29     ' ★ 作業列2 行を挿入した行番号を格納するための変数
  Const SeqCol As Integer = 65     ' ★ 作業列2の列番号の変数
  Const EdaNum As Integer = 66     ' ★ 作業列2の拡張  枝番を格納するための行
  Dim i As Long            ’★ 制御変数
  
  If mySht Is Nothing Then Exit Sub
  With mySht
    If Not myRow Is Nothing Then
      On Error Resume Next
      myInsRow = myRow.Row

      If Err().Number <> 0 Then        
        ’単純な行の挿入の場合、SeqCol列の空白を探す
        Set w_FndRng = Range(Cells(TopRow, SeqCol), Cells(Rows.Count, SeqCol).End(xlUp)).Find("", , xlValues, xlWhole, xlByRows, xlNext)
 
        If Not w_FndRng Is Nothing Then
          ' 単純に行挿入された場合 SeqCol列のどこかには""空白のセルがある
          myInsRow = w_FndRng.Row
        Else
          ' コピーして挿入 の場合、作業列2には 元の行の値が入っている 
          i = TopRow
          Do While (i < Rows.Count)
            If Cells(i, EdaNum) > 1 Then
              myInsRow = i
              Exit Do
            End If
            i = i + 1
          Loop
        End If
        
        RaiseEvent RowsInsert(myCancel, myInsRow)
        If myCancel Then
          Application.Undo
        End If
      End If
    End If
    Set myRow = .Rows(.Rows.Count)
  End With
End Sub


’***************************************
' ' ThisWorkbook
' ***************************************


Private Declare Function SetTimer Lib "user32" ( _
  ByVal Hwnd As Long, ByVal nIDEvent As Long _
  , ByVal uElapse As Long, ByVal lpTimerFunc As Long) _
  As Long
Private Declare Sub KillTimer Lib "user32" ( _
  ByVal Hwnd As Long, ByVal nIDEvent As Long)

Private WithEvents myRowsInsertEventClass As clsRowsInsertEvent
Private myTimerId As Long

Private Sub myRowsInsertEventClass_RowsInsert(Cancel As Boolean, myInsRow As Long)
  '
  '★ 作業列1 時刻取得して タイムスタンプをとる(予定)
  '★ 作業列2 シーケンシャル番号を格納する(予定)
  MsgBox myInsRow & "行に挿入されました" ’★ 挿入位置を確認するためのMsgBoxを出力
  
  Cancel = MsgBox("行が挿入されました。" & vbCrLf _
    & "キャンセルしますか?", vbInformation Or vbYesNo) = vbYes
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim myRes As VbMsgBoxResult
  If Not Saved Then
    myRes = MsgBox("'" & Name & "' への変更を保存しますか?" _
      , vbExclamation Or vbYesNoCancel)
    If myRes = vbYes Then
      Save
    ElseIf myRes = vbNo Then
      Saved = True
    Else
      Cancel = True
      Exit Sub
    End If
  End If
  KillTimer 0&, myTimerId
  Set myRowsInsertEventClass = Nothing
End Sub

Private Sub Workbook_Open()
  myTimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub

Public Property Get RowsInsertEventClass() As clsRowsInsertEvent
  If myRowsInsertEventClass Is Nothing Then
    Set myRowsInsertEventClass = New clsRowsInsertEvent
  End If
  Set RowsInsertEventClass = myRowsInsertEventClass
End Property

'***********************************************************
' 標準モジュール
'***********************************************************
Sub TimerProc(ByVal Hwnd As Long, ByVal uMsg As Long _
  , ByVal idEvent As Long, ByVal dwTime As Long)
  On Error Resume Next
  ThisWorkbook.RowsInsertEventClass.CheckRowsInsert Sheet3 ’★井川さんのオリジナルは 引数Sheet1
End Sub
・ツリー全体表示

【78071】Re:確認した変数を他のマクロ上で使用す...
発言  β  - 16/3/26(土) 18:19 -

引用なし
パスワード
    ▼mjhwc152 さん:

色番号は、数値です。
たとえば 黒は 0、赤は 255、黄色は 65535 等々。
でも色番号をコード内で使用すると、わかりにくいですね。
エクセルでは以下の8色について、変数を使うことができます。

黒(vbBlack)
白(vbWhite)
赤(vbRed)
明るい緑(vbGreen)
青(vbBlue)
黄(vbYellow)
ピンク(vbMagenta)
水色(vbCyan)

ですからたとえば以下。


Sub Macro()

 If color = vbRed Then
   Macro1 (単にこの書き方で指定した移動先のマクロに飛びますか?)
 ElseIf color = vbBlack Then
   Macro2
 Else
   Macro3
  End If

End Sub

・ツリー全体表示

【78070】Re:指定したセルのフォントカラーの確認...
お礼  mjhwc152 E-MAIL  - 16/3/26(土) 17:39 -

引用なし
パスワード
   ▼β さん:
早速のご伝授り難う御座いました。

「 color = Range("A1").Font.color 」は良く理解できました。

最初〜全てを質問すれば良かったのですが、合わせて知りたかった事項が有ったのですが、全てを書かずに質問してしまいました。

改めて「78069」確認した変数を他のマクロ上で使用する為の処理と方法を教えて下さい。で続きの質問を投稿させて頂いています。宜しかったら続けてご伝授願います。

済みませんでした。
・ツリー全体表示

【78069】確認した変数を他のマクロ上で使用する為...
質問  mjhwc152 E-MAIL  - 16/3/26(土) 17:21 -

引用なし
パスワード
   先に 【78068】の質問の内容で
Re:指定したセルのフォントカラーの確認方法を

βさんから、下記の回答頂き、お礼にて送信しましたが、送信未確認の為、追加質問にしました。
 
Sub Test()
  Dim color As Variant
  
  color = Range("A1").Font.color
  
  If IsNull(color) Then
    MsgBox "文字ごとに文字色が異なっています"
  Else
    MsgBox "文字の色コードは " & color & " です"
  End If
  
End Sub

ここで判明した「color」を使い、次の様な Sub Macro()にてのcolor」を使用する為の宣言方法と手順を知りたい。又、下記の IF 処理で「Macro1〜Macro3」へのマクロの移動処理を実施したいのですが、方法は合っていますか? ご伝授下さい。

Sub Macro()

 If color = 赤 Then
   Macro1 (単にこの書き方で指定した移動先のマクロに飛びますか?)
 Else If color = 黒 Then
   Macro2
 Else
   Macro3
 End If

End Sub
・ツリー全体表示

218 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free