[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA モードレスフォームにつけた動的ボタンのクリックイベントが発生しない』（misskabu）
すいません。色々検索したのですが同じ事例が見つからず質問させてください。
エクセルVBAで動的にボタンを生成し、フォームに張り付けるコードを作ったのですが、対象のフォームがvbModalだとボタンイベントが動くのにvbModalessにするとボタンにフォーカスが当たりクリックはできますがイベントが発生しなくなります。モーダレスモードでないと使い物にならないソフトなので改善できるか教えてもらえませんか？以下コードです。
そもそも不可能かどうかだけでもわかると助かります。
'コードのない空フォームとしてTimeCardButtonFormがあります
'触ったプロパティはShowModal=falseのみです。
'FormMaker 標準モジュール
Option Explicit
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'動的にボタンを生成してフォームに張り付けるための標準モジュール
'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Sub make_form(timeCards As Collection)
Dim i As Integer
Dim btn As Control
Dim buttons As New Collection
i = 1
Dim key As Variant
For Each key In timeCards
Dim card As timecard
Set card = key
Dim name As String
name = card.出勤時間 & "-" & card.退勤時間
Set btn = TimeCardButtonForm.Controls.Add("Forms.CommandButton.1", name) '第一引数はシステム定数なのでこの通りかかないとダメ
With btn
.Top = 5 + (i - 1) * 20
.Left = 5
.Height = 20
.Width = 60
.Caption = name
End With
Dim newButton As TimeCardButton
Set newButton = New TimeCardButton
Set newButton.button = btn
Set newButton.出退勤 = card
buttons.Add newButton
i = i + 1
Next
With TimeCardButtonForm
.Height = i * 20 + 10
.Width = 70
.Show
End With
End Sub
'アプリの起動
Sub testMain()
Dim timeCards As Collection
Set timeCards = New Collection
Dim card As timecard
Set card = New timecard
card.出勤時間 = "8"
card.退勤時間 = "17"
timeCards.Add card
Call make_form(timeCards)
End Sub
'TimeCard クラスモジュール
Option Explicit
'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'一日分の出勤日、出勤時間、退勤時間を表すクラス
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public 日付 As Date
Public 出勤時間 As String
Public 退勤時間 As String
'この日の労働時間をメンバ変数から計算する。
'IsNumericで「公休」等の数字以外の文字が入っていないかチェック
'深夜労働の計算:深夜に出勤するとマイナスになるので24足している
'休憩時間の計算:８時間以上働いたら１時間休んでいるはずという計算
Public Property Get 労働時間() As Integer
If IsNumeric(出勤時間) And IsNumeric(退勤時間) Then
労働時間 = 退勤時間 - 出勤時間
If 労働時間 < -1 Then
労働時間 = 労働時間 + 24
End If
If 労働時間 >= 8 Then
労働時間 = 労働時間 - 1
End If
Else
労働時間 = 0
End If
End Property
'TimeCardButtonクラス
Option Explicit
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'動的にボタンを作るためのクラス。
'TimeCardButtonFormに張り付けるボタンを定義する
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public WithEvents button As CommandButton
Public 出退勤 As timecard
'TimeCardButtonFormのボタンが押されたときの処理
Private Sub button_Click()
WorkSheetWriter.WriteTimeCard Me.出退勤
End Sub
'WorkSheetWriter 標準モジュール
Option Explicit
'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'データをワークシートに転記するメソッドを纏めたモジュール
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Enum 列
開始列 = 3
前月締日 = 7
月初 = 8 '１６日の事
最終列 = 39
労働時間列 = 40
公休列 = 41
週休列 = 42
End Enum
Private Enum 行
日付行 = 4
End Enum
'引数に渡された出退勤時間をアクティブセルに記入する
Public Sub WriteTimeCard(card As timecard)
Selection = card.出勤時間
ActiveCell.Offset(1, 0).Activate
Selection = card.退勤時間
ActiveCell.Offset(-1, 1).Activate
End Sub
'引数に渡されたスタッフの基本シフトを転記
Public Sub WriteBasicShift(スタッフ As Staff)
If スタッフ.名前 = "" Then
Debug.Print "この列には誰もいません"
Else
Dim currentDay As String '検索範囲の日付を順次代入
Dim column As Integer
Dim 月曜日 As timecard
Dim 火曜日 As timecard
Dim 水曜日 As timecard
Dim 木曜日 As timecard
Dim 金曜日 As timecard
Dim 土曜日 As timecard
Dim 日曜日 As timecard
On Error Resume Next
Set 月曜日 = スタッフ.基本シフト.Item("月曜日")
Set 火曜日 = スタッフ.基本シフト.Item("火曜日")
Set 水曜日 = スタッフ.基本シフト.Item("水曜日")
Set 木曜日 = スタッフ.基本シフト.Item("木曜日")
Set 金曜日 = スタッフ.基本シフト.Item("金曜日")
Set 土曜日 = スタッフ.基本シフト.Item("土曜日")
Set 日曜日 = スタッフ.基本シフト.Item("日曜日")
Application.ScreenUpdating = False
Dim i As Integer
For i = 列.月初 To 列.最終列
currentDay = DateValue(Cells(行.日付行, i).Value)
Select Case Weekday(currentDay)
Case vbSunday
Cells(スタッフ.row, i).Value = 日曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 日曜日.退勤時間
Case vbMonday
Cells(スタッフ.row, i).Value = 月曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 月曜日.退勤時間
Case vbTuesday
Cells(スタッフ.row, i).Value = 火曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 火曜日.退勤時間
Case vbWednesday
Cells(スタッフ.row, i).Value = 水曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 水曜日.退勤時間
Case vbThursday
Cells(スタッフ.row, i).Value = 木曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 木曜日.退勤時間
Case vbFriday
Cells(スタッフ.row, i).Value = 金曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 金曜日.退勤時間
Case vbSaturday
Cells(スタッフ.row, i).Value = 土曜日.出勤時間
Cells(スタッフ.row + 1, i).Value = 土曜日.退勤時間
End Select
Next i
Application.ScreenUpdating = True
End If
End Sub
'引数に渡されたスタッフの前月とかぶる１１日から１５日までを前月のシートからコピーする
Public Sub CopyFromPreviousMonth(スタッフ As Staff)
If スタッフ.名前 = "" Then
Else
Dim rg As Range
Dim targetDay As Date
Dim i As Integer
Application.ScreenUpdating = False
For i = 列.開始列 To 列.前月締日
targetDay = Cells(行.日付行, i)
Dim card As timecard
For Each card In スタッフ.前月シフト
If card.日付 = targetDay Then
Cells(スタッフ.row, i).Value = card.出勤時間
Cells(スタッフ.row + 1, i).Value = card.退勤時間
End If
Next
Next i
Application.ScreenUpdating = True
End If
End Sub
'ワークシートに祝日を書き込む
Public Sub WriteLegalHoliday(祝日 As Schedule)
Dim targetDay As Date '検索範囲の日付を順次代入
Application.ScreenUpdating = False
Dim i As Integer
For i = 列.月初 To 列.最終列
targetDay = Cells(行.日付行, i).Value
Dim イベント As Events
For Each イベント In 祝日.祝日リスト
If イベント.日付 = targetDay Then
Cells(祝日.作業行, i).Value = イベント.内容
End If
Next
Next i
Application.ScreenUpdating = True
End Sub
'ワークシートに会議等の予定を書き込む
Public Sub WriteMeetingDay(会議リスト As Schedule)
Dim targetDay As Date '検索範囲の日付を順次代入
Application.ScreenUpdating = False
Range(Cells(会議リスト.作業行, 列.開始列), Cells(会議リスト.作業行 + 1, 列.最終列)).Select
Selection.Interior.color = vbWhite
Selection.ClearContents
Dim i As Integer
For i = 列.月初 To 列.最終列
targetDay = Cells(行.日付行, i).Value
Dim イベント As Events
For Each イベント In 会議リスト.会議等
If イベント.日付 = targetDay Then
Cells(会議リスト.作業行, i).Value = イベント.内容
Range(Cells(会議リスト.作業行, i), (Cells(会議リスト.作業行 + 1, i + イベント.期間))).Interior.color = vbYellow
End If
Next
Next i
Application.ScreenUpdating = True
End Sub
'ワークシートの労働時間欄に労働時間を書き込むメソッド
Public Sub WriteWorkTime(スタッフ As Staff)
Cells(スタッフ.row, 列.労働時間列).Value = スタッフ.月間労働時間
End Sub
'ワークシートに公休、週休回数を書き込むメソッド
Public Sub WriteNumOfPublicHoliday(スタッフ As Staff)
Cells(スタッフ.row, 列.公休列).Value = スタッフ.公休回数
Cells(スタッフ.row, 列.週休列).Value = スタッフ.週休回数
End Sub
＜ 使用 Excel：Excel2007、使用 OS：Windows10 ＞
それとMeをちゃんと明示してやるとどうなりますか
（名無し） 2017/03/16(木) 17:39
またdebug.printでの確認は行なっておりますが無反応だっため投稿させて頂きました。
Meをどこで明示すればいいのか分からなかったのですが、その辺りも意識してやってみます。
コメント有難うございました。
（misskabu） 2017/03/16(木) 18:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.