[[20081029131708]] 『リストボックス代入時の実行時エラー '438"につい』（まき） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『リストボックス代入時の実行時エラー '438"について』（まき）
いつも色々参考にさせて頂いております。表題の件は先日も質問させて頂きましたが、
他の所でも起きてしまいましたので、再度ご伝授願います。
現在２つのｂｏｏｋを使用して（１つはＶＢＡと画面表示【確認.xls】、もう１つは
データー保存用【予約.xls】）おり、確認.xlsのフォームのリストボックスに予約.xlsか
らのセルを表示させたいと考えております。
ファイルを１つのbookの時には表示出来たのですが、パッチを発行する事を考え２つの
bookに分けてから上記エラーを表示してしまいました。本VBA(確認.xls)は下記の通りです。
Private Sub 確認_Click() Dim 装置名 As String Dim 号機名 As String Dim リストボックス As Range Dim x As Integer: Dim y As Integer Dim x1 As Integer: Dim y2 As Integer
If ComboBox11.Value <> "" Then
装置名 = Range("C3").Value
号機名 = ComboBox11.Value
Worksheets("メニュー").Range("C3:IV50").Clear
ComboBox11 = ""
ComboBox11.ListFillRange = vbNullString
Application.Visible = False '画面を隠す
予約確認.TextBox1.Text = 装置名 'テキストボックス１へ装置名を設定
予約確認.TextBox2.Text = 号機名 'テキストボックス２へ号機名を設定
If 装置名 = "400" Then
Application.Visible = True '再表示
Windows("予約.xls").Activate
Sheets("400予約").Select
Sheets("400予約").Cells.Find(What:=号機名, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
y = ActiveCell.Row 'yにActiveのRow(y軸：数字)の数字を表示
x = ActiveCell.Column 'xにActiveのColumn(x軸：英字)の数字を表示
Sheets("400予約").Cells(y, x).End(xlDown).Activate '上記セルの最終行を検索
y2 = ActiveCell.Row 'y2にActiveのRowの数字代入
' Sheets("400予約").Range("A1") = Cells(y + 2, x).Address(False, False, xlA1)'デバッグの為アドレス値をoutput
Set リストボックス = Windows("予約.xls").Sheets("400予約").Range(Cells(y + 2, x), Cells(y2, x))'※ここでエラーになります。
予約確認.ListBox1.RowSource = リストボックス
予約確認.Show
End If
Else
MsgBox "号機が選択されていません。", 16, "レンタル管理"
End If
End Sub
エラー表示をWindows("予約.xls").Sheets("400予約").Range(Cells(y + 2, x), Cells(y2, x)).Select
や.Copy等でデバッグしてみました所、Windows("予約.xls").Sheets("400予約")が選択
が出来ておりません。また、エラー部やこれより上の部分で
Workbooks("予約.xls").Worksheets("400予約") → 他のbookシートから選択出来ない、フォームからはOK
Windows("予約.xls").Activate
Sheets("400予約").Select →これだと他のbookシートからでもOK
とすると選択出来ないと言うもの？？です。VBAはやり始めたばかりで、他の方の質問
のＱ＆Ａをコピペしているだけなので、抜本的な問題が有るのかもしれません。
お手数をお掛け致しますが、よろしくお願い申し上げます。
>Set リストボックス = Windows("予約.xls").Sheets("400予約").Range(Cells(y + 2, x), Cells(y2, x))'※ここでエラーになります。
with workbooks("予約.xls").Sheets("400予約")
set リストボックス=.Range(.Cells(y + 2, x), .Cells(y2, x))
end with
このようにして試してみてください。 変数yやy2が正しい値なら、これで作動すると思います。
ichinose
提案内容は ichinose さんと同じなのですが、長々と書いてしまったので
重複ですが投稿します。
Private Sub 確認_Click() は 確認.xls に登録されている、
ということなので・・・
【実行時エラー '438の直接の原因】
Windows("予約.xls").Sheets("400予約").Range(Cells(y + 2, x), Cells(y2, x))
SheetsコレクションはWindowsオブジェクトではなく、Workbooksオブジェクトの
下位オブジェクトです。Windowsオブジェクトの下位オブジェクトでないものを
指定しているので、「サポートしていません」
【更なる問題】
ただ、単に上記の問題を改善すればよいということではなくて、
Workbooks("予約.xls").Sheets("400予約").Range(Cells(y + 2, x), Cells(y2, x))
としただけでは、
「実行時エラー '1004' アプリケーション定義またはオブジェクト定義のエラーです」
となるはずです。
Cells(y + 2, x) や Cells(y2, x) の親オブジェクトが指定されていないからです。
のCells(y + 2, x)、および、Cells(y2, x) は上位オブジェクトが明示的に指定さ
れていないので、コードが書かれた確認.xlsのオブジェクトとして取得しようとします。
デバッグ時にCells(y + 2, x)をウォッチ式に追加し、Parent（親）プロパティのさら
にそのParentプロパティのNameプロパティを 確認してもらえば、このオブジェクト式
が 「確認.xls」 のものを取得していることが確認できます。
[予約.xls]の矩形範囲のRangeプロパティを取得するのに、
[確認.xls]に存在する二つのセルを基準とすることは出来ません。
この1行は次のように書き換えるべきです。
With Workbooks("予約.xls").Sheets("400予約")
Set リストボックス = .Range(.Cells(y + 2, x), .Cells(y2, x))
End With
標準モジュール以外にコードが書かれている場合で、親オブジェクトの省略をするときは
注意が必要です。アクティブであるかどうかは関係ない場合が多いので、オブジェクト取得に
Select、Activateに頼るのは混乱の元です。
例えば、Book2のユーザーフォームから
Private Sub CommandButton1_Click()
Workbooks("book1.xls").Activate
MsgBox Range("a1").Value
End Sub
のようにするとアクティブブックのアクティブシートのセルA1の値を取得してしまうので
混乱を招くのですが、コードのおかれているオブジェクト以外を取得しようとするときには
親オブジェクトを明示するように心がけておくと、失敗は減るでしょう。
というか、やはり、「他の方の質問 のＱ＆Ａをコピペしているだけ」ではこの部分は
理解しにくいかもしれません。
(みやほりん)(-_∂)b
ichinose 様、みやほりん 様
ご連絡頂き有り難うございました。
さて、デバッグも含め次の通り明記し直しました。
Private Sub 確認_Click() Dim 装置名 As String Dim 号機名 As String Dim R1 As String: Dim R2 As String: Dim R3 As String Dim リストボックス As Range Dim x As Integer: Dim y As Integer Dim x1 As Integer: Dim y2 As Integer
If ComboBox11.Value <> "" Then
装置名 = Range("C3").Value
号機名 = ComboBox11.Value
Worksheets("メニュー").Range("C3:IV50").Clear
ComboBox11 = ""
ComboBox11.ListFillRange = vbNullString
Application.Visible = False '画面を隠す
予約確認.TextBox1.Text = 装置名 'テキストボックス１へ装置名を設定
予約確認.TextBox2.Text = 号機名 'テキストボックス２へ号機名を設定
If 装置名 = "400" Then
Application.Visible = True '再表示
Windows("予約.xls").Activate
Sheets("400予約").Select
Sheets("400予約").Cells.Find(What:=号機名, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
y = ActiveCell.Row 'yにActiveのRow(y軸：数字)の数字を表示
x = ActiveCell.Column 'xにActiveのColumn(x軸：英字)の数字を表示
Sheets("400予約").Cells(y, x).End(xlDown).Activate '上記セルの最終行を検索
y2 = ActiveCell.Row 'y2にActiveのRowの数字代入
R1 = Cells(y + 2, x).Address(False, False, xlA1)
R2 = Cells(y2, x + 3).Address(False, False, xlA1)
R3 = Cells(y2, 12).Address(False, False, xlA1)
With Workbooks("予約.xls").Sheets("400予約")
Set リストボックス = .Range(.Cells(y + 2, x), .Cells(y2, x))
.Range(R1, R2).Select
.Range(.Cells(y + 2, x), .Cells(y2, x + 2)).Select 'これでもＯＫです。
Selection.Copy
End With
With Workbooks("確認.xls")
.Sheets("作業シート").Range("L3").PasteSpecial '正しくcopyされているか確認
Workbooks("確認.xls").Activate
' 予約確認.ListBox1.RowSource = "作業シート!L2:" & R3 & "" '※これだと入る
予約確認.ListBox1.RowSource = リストボックス '※これだと実行時エラー13：型が一致しません。
予約確認.Show
End With
End If
Else
MsgBox "号機が選択されていません。", 16, "レンタル管理"
End If
End Sub
変数”リストボックス”で代入しようとすると、実行時エラー13：型が一致しません。でエラーになりました。
デバッグをかねる意味で、確認.xlsに作業シートを作りここからListBox1.RowSourceを指定すると読み込めます。
バッファーシートを作る事で目的値をフォームのListBox1に代入出来ましたが、変数”リストボックス”
で代入出来なかったのはどうしてなのでしょうか。過去のログでDim リストボックス As Rangeにして
フォームにあるRowSourceに代入出来たと見かけた様に記憶しております。
以上よろしくお願い致します。
上手く行った方法では、 予約確認.ListBox1.RowSource = "作業シート!L2:" & R3 & "" ^^^^^^^^^^^^^^^^^^^^^^^^^^ ここは文字列。（ & "" は蛇足） ヘルプを見ると、このステートメントは、object.RowSource [= String] という書式。 つまり、RowSourceプロパティに代入できるのは「String型のデータ」です。 変数リストボックスは、Range型の変数として宣言されており、それをRowSourceに代入しようと しても「型が一致しません」となります。 RowSourceに代入するべき、適当な文字列データを、変数リストボックスから取得する必要があ ります。 (みやほりん)(-_∂)b
みほりんさん、
ご丁寧な説明頂き有り難うございました。確かにHELPファイルを見てみるとRowSourceに代入出来るのは、
String型のみでした。ご指摘を頂き前に何度かHELPを見たのですが、HELPの意味を捕らえ切れていなかっ
た様です。そこで、感じた事をご質問させて頂きます。
１．wn = ActiveWorkbook.Nameやws = ThisWorkbook.ActiveSheet.Nameでパスを取得して、
予約確認.ListBox1.RowSource = ws &"!"& wn &"!"& R1 & ":" & R2
"予約.xls!作業シート!& R1 & ":" & R2 → では駄目
表記した所、他のbookのsheetをListBox1.RowSourceに入れる事が出来ませんでし
た。やはり、他のbookを入れる事は不可能なのでしょうか？
２．上手く行った方法でその後のチェックを行いました。具体的に何をしたいのかと申し
上げると、ユーザーフォーム上に予約.xlsの作業シートの一部をリンクさせ、削除
（その際にはリンク先の行を削除）や変更を行いたいのですが、この様な方法はフォー
ムじゃ出来ないのでしょうか。以前みほりんさんが説明されていた、MS Office
Speadsheet10.0で指定されてシートを読み込んで出来れば良いのですが、それも試し
て見たのですが、リンクで入れる事が出来なかったのと、Office20007を使用してい
る人がいるのでどちらにせよ不可。これを行おうとするには、ユーザーフォームでは
なく、対象シートを直接開きそこにマクロボタン等を配置しないと無理でしょうか。
（別議題として上げる内容ですが）具体的には次の事を行いたいです。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
｜ユーザーフォーム ｜
｜ −−−−−−−−−−−−−−−−−−−−−−− ｜
｜ ｜ 予約日 完了日 ユーザー名 現場 ｜ ｜
｜ ｜ 08-10-10 08-10-15 ○×会社 東京 ｜ ｜
｜ ｜ 08-10-20 08-10-25 ○×会社 埼玉※ ｜ ｜
｜ ｜ ↑ListBox ｜ ｜
｜ −−−−−−−−−−−−−−−−−−−−−−− ｜
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
※イネーブルにしてボタンを配置し（可能であれば右クリック）削除や変更を行う。
以上よろしくお願い致します。
１． 書式が違ってますね。 Me.ListBox1.RowSource = "[book1.xls]Sheet1!A1:A10" こんな感じ。対象にするブックが必ず開いている必要があります。 ２． リストボックスは編集ができましたっけ？ （編集目的で使ったことないので） 私がリストボックスで編集のためのインターフェースを作るとしたら、 ＞リストボックスから編集したいデータを選択 ＞選択したデータを編集のためのテキストボックスに項目ごとに転記 ＞テキストボックスで目的の部分を編集 ＞編集後に転記するためのボタンなどにより編集内容を適切な位置へ転記 という仕組みにします。 ＞この様な方法はフォームじゃ出来ないのでしょうか。 「多分出来るんじゃないでしょうか」くらいしか答えられません。 断片的な知識しか与えられていない私に結論を下せる問題ではありませんから。 細かい仕様が分らない以上、開発する人が判断するべきことです。 (みやほりん)(-_∂)b
リストボックスを使っての更新・削除処理の仕様は、みやほりんさんとほぼ同じですねえ！！
簡単なサンプルコ-ドです。と言っても長いですよ！！
概略仕様 新規ブックにて、Sheet1にサンプルデータを作成します。このデータをユーザーフォーム上のリストボックを 使って、更新･削除することを考えます。
リストボックスに表示されたデータを選択後、右クリックするとポップアップメニューが表示されます。
ポップアップメニューには、変更、削除があります。
削除
選択された行を削除します。
変更
変更は、新しいユーザーフォームが表示され、選択された内容が表示されますから、 変更する箇所を変更してください。
変更後、「修正」ボタンクリックで、選択された行が更新されます。 「取り消し」ボタンは、更新を行いません。
では、次投稿でコードです。 ichinose
新規ブックにて（あくまでも新規ブックです）、
ユーザーフォームを二つ用意してください。
UserForm1 （リストボックスにて、更新データ選択用)
UserForm2 （リストボックスにて、選択データの変更用)
二つのユーザーフォームは、ユーザーフォームだけ作成してください。 中のコントロール（リストボックスやテキストボックスやボタン等）は、コードで作成しますから、 何も配置しないでください。
クラスモジュールも二つ用意してください。
Class1 及び、 Class2 既定の名前で結構です。
標準モジュールも一つ用意してください（Module1）。
＊サンプルデータをSheet1に作成しますから、Sheet1というシート名のシートが 存在することを確認してください。
では、まず
Class1のモジュールから、
'=====================================================================================
Option Explicit
Event click(ByVal caption As String) 'イベントを定義
Private cmdbar As Office.CommandBar 'ポップアップメニュー
Const Bnm As String = "ppumenu"
Private ppb() As Class2
'=====================================================================================
Sub init()
On Error Resume Next
Application.CommandBars(Bnm).Delete
Set cmdbar = Application.CommandBars.Add(Bnm, msoBarPopup, , True)
End Sub
'=====================================================================================
Sub term()
On Error Resume Next
Dim g0 As Long
For g0 = LBound(ppb()) To UBound(ppb())
Set ppb(g0).parent = Nothing
Set ppb(g0).btn = Nothing
Set ppb(g0) = Nothing
Next
Application.CommandBars(Bnm).Delete
On Error GoTo 0
End Sub
'=====================================================================================
Sub addbtn(ByVal cap As Variant)
Dim g0 As Long
On Error Resume Next
g0 = UBound(ppb()) + 1
If Err.Number <> 0 Then g0 = 1
On Error GoTo 0
ReDim Preserve ppb(1 To g0)
Set ppb(g0) = New Class2
With ppb(g0)
Set .parent = Me
Set .btn = cmdbar.Controls.Add(msoControlButton)
With .btn
.Style = msoButtonCaption
.caption = cap
End With
End With
' On Error GoTo 0
End Sub
'=====================================================================================
Sub showup(Optional flg As Boolean = True)
Dim cmdbtn As Object
For Each cmdbtn In cmdbar.Controls
cmdbtn.Enabled = flg
Next
cmdbar.ShowPopup
End Sub
'=====================================================================================
Sub callback(ByVal cbtn As Office.CommandBarButton)
RaiseEvent click(cbtn.caption)
End Sub
次にClass2のモジュール
'=====================================================================================
'ポップアップメニューの各ボタンがクリック時のイベントプロシジャー
Option Explicit
Public parent As Object
Public WithEvents btn As Office.CommandBarButton
Private Sub btn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Call parent.callback(btn)
End Sub
UserForm1のモジュール
'=====================================================================================
Option Explicit
Private WithEvents lst1 As MSForms.ListBox
Private WithEvents pmenu As Class1
Const upd = "変更"
Const del = "削除"
'=====================================================================================
Private Sub lst1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
pmenu.showup (lst1.ListIndex >= 0)
End If
End Sub
'=====================================================================================
Private Sub pmenu_click(ByVal caption As String) '変更や削除ボタンクリック時の処理
Dim g0 As Long
Dim sht As Worksheet
If caption = upd Then
Load UserForm2
With UserForm2
g0 = lst1.ListIndex
.t_yoyaku.Value = Format(lst1.List(g0, 0), "yy-m-d")
.t_kanryo.Value = Format(lst1.List(g0, 1), "yy-m-d")
.t_user.Value = lst1.List(g0, 2)
.t_genba.Value = lst1.List(g0, 3)
.Show
If .update Then
Set sht = Worksheets("sheet1")
sht.Cells(g0 + 2, 1).Value = CDate(.t_yoyaku.Value)
sht.Cells(g0 + 2, 2).Value = CDate(.t_kanryo.Value)
sht.Cells(g0 + 2, 3).Value = .t_user.Value
sht.Cells(g0 + 2, 4).Value = .t_genba.Value
End If
Call set_listbox
End With
Unload UserForm2
ElseIf caption = del Then
Worksheets("sheet1").Rows(lst1.ListIndex + 2).Delete
Call set_listbox
End If
End Sub
'=====================================================================================
Private Sub UserForm_Initialize()
Dim rng As Range
With Me
.Width = 367
.Height = 237
.caption = "データメンテナンス"
Set lst1 = .Controls.Add("Forms.ListBox.1", , True)
With lst1
.Left = 6
.Top = 6
.Width = 354
.Height = 210
End With
End With
' ↑ここまでは、本来は、手動操作で設定する
With Worksheets("sheet1")
Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp)).Resize(, 4)
End With
If rng.Row > 1 Then
With lst1
.ColumnHeads = True
.ColumnCount = 4
.RowSource = rng.Address(, , , True)
.TextAlign = fmTextAlignLeft
End With
End If
Set pmenu = New Class1
With pmenu
.init
.addbtn upd
.addbtn del
End With
End Sub
'=====================================================================================
Sub set_listbox() 'リストボックスにシートのデータの設定
Dim rng As Range
With Worksheets("sheet1")
Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp)).Resize(, 4)
End With
If rng.Row = 1 Then
With lst1
.RowSource = ""
End With
End If
End Sub
'=====================================================================================
Private Sub UserForm_Terminate()
pmenu.term
Set pmenu = Nothing
End Sub
UserForm2のモジュール
'=====================================================================================
Option Explicit
Public WithEvents t_yoyaku As MSForms.TextBox
Public WithEvents t_kanryo As MSForms.TextBox
Public WithEvents t_user As MSForms.TextBox
Public WithEvents t_genba As MSForms.TextBox
Private WithEvents b_upd As MSForms.CommandButton
Private WithEvents b_can As MSForms.CommandButton
Public update As Boolean 'true 修正ボタンが押された False 修正ボタンが押されていない
'=====================================================================================
Private Sub b_can_Click()
Me.Hide
End Sub
'=====================================================================================
Private Sub b_upd_Click()
update = True
Me.Hide
End Sub
'=====================================================================================
Private Sub UserForm_Initialize()
Dim tt As Variant
Dim g0 As Long
With Me
.caption = "データの更新"
.Width = 330
.Height = 200
Set t_yoyaku = .Controls.Add("Forms.TextBox.1", , True)
With t_yoyaku
.Left = 78
.Top = 12
.Width = 84
.Height = 18
.Font.Size = 12
.TextAlign = fmTextAlignCenter
End With
Set t_kanryo = .Controls.Add("Forms.TextBox.1", , True)
With t_kanryo
.Left = 78
.Top = 42
.Width = 84
.Height = 18
.Font.Size = 12
.TextAlign = fmTextAlignCenter
End With
Set t_user = .Controls.Add("Forms.TextBox.1", , True)
With t_user
.Left = 78
.Top = 72
.Width = 228
.Height = 18
.Font.Size = 12
.TextAlign = fmTextAlignLeft
End With
Set t_genba = .Controls.Add("Forms.TextBox.1", , True)
With t_genba
.Left = 78
.Top = 102
.Width = 228
.Height = 18
.Font.Size = 12
.TextAlign = fmTextAlignLeft
End With
Set b_upd = .Controls.Add("Forms.CommandButton.1", , True)
With b_upd
.Left = 12
.Top = 144
.Width = 84
.Height = 24
.caption = "修正"
End With
Set b_can = .Controls.Add("Forms.CommandButton.1", , True)
With b_can
.Left = 96
.Top = 144
.Width = 84
.Height = 24
.caption = "取り消し"
End With
g0 = 12
For Each tt In Array("予 定 日", "完 了 日", "ユーザー名", "現 場")
With .Controls.Add("Forms.Label.1", , True)
.SpecialEffect = 2
.Left = 12
.Top = g0
.Width = 66
.Height = 18
.Font.Size = 14
.caption = tt
.BackColor = &HFFFF00
g0 = g0 + 30
End With
Next
End With
' ↑ここまでは、本来は、手動操作で設定する
update = False
End Sub
'=====================================================================================
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then
Me.Hide
Cancel = True
End If
End Sub
'尚、ここでは、修正されたデータのエラーチェックはしていません。本来は、
'ここでそれぞれの項目に対してエラーのチェックのコードが必要になります。
'最後に標準モジュールに
'================================================================================
Option Explicit
Sub main()
Call mk_sample
MsgBox "ご覧のデータをユーザーフォームを使って更新します"
UserForm1.Show
End Sub
'================================================================================
Sub mk_sample() 'サンプルデータ作成
With Worksheets("sheet1")
.activate
.Cells.NumberFormatLocal = "G/標準"
.Range("a1:d1").Value = Array("予約日", "完了", _
"ユーザー名", "現場")
.Range("a:b").NumberFormatLocal = "yy-m-d"
With .Range("a2:d10")
.Formula = Array("=int(rand()*150)+39448", _
"=a2+30", _
"=rept(jis(char(63+row())),3)&""会社""", _
"=choose(int(rand()*5)+1,""東京"",""神奈川""," & _
"""埼玉"",""千葉"",""山梨"")")
.Value = .Value
End With
.Range("c:d").NumberFormatLocal = "@"
End With
End Sub
コードは、以上です。
mainを実行してみてください。
尚、リスト表示後、右クリックでのポップアップメニューは、リストボックス内のいずれかの データを選択していないと使用可能にはなりませんので 注意してください。
長くなりましたが、試してみてください。
マン・マシンインターフェースのコードは、どうしても長くなってしまいますね！！
ichinose 11/1 20:9 訂正
ichinose 様、 みほりん 様
色々有り難うございます。３連休の為上記の件が実行出来ず、また明日が出張の為水曜以降の対応となっ
てしまいますので、お返事が遅れてしまう事をお許し願います。本予約システムは当初アクセスで作るつ
もりでしたが、全員のPCにアクセスが無い為、エクセルでの製作となりました。アクセスの様に予約IDな
る物が有れば、どこのフォームにても削除や変更が出来るのですが、エクセルにはこの様なIDが無い為
に、リンクで持ってきたりするしかないかなぁと考えていました。仮にリンクで持って来ても、個別の
セルだけを削除して（キャンセル時）、ベースとなるsheetの方も同時に削除出来かつ上につめると言う
事が出来るのか本質問中に疑問になってしまいました。ichinose様の言われる通り、作業シート(その都
度）に貼り付けて行ってみようかと思います。上記VBAは私レベルでは今見ただけではピンと来ない為、
step by syepで行ってみます。
お休みの日の対応頂き有り難うございました。今日このお返事を見るまでは、やっぱりアクセスで作り
直そうか悩んでいた所でした。個人的にはまだVBAをやり始めて日が浅いのですが(本職は営業)、アクセ
スばかりでVBAを作っており、エクセルでどこまで行えるのかと言うのがまったく疑問でした。
では、水曜日の午後から試してみます。
以上よろしくお願い致します。
ichinose 様、 みほりん 様
色々お世話になっております。帰社後、ご指導頂いた内容通り実施してみました。
みほりん 様
はやり私の基礎が出来ていないかと思うのですが、Me.を継ぎ足すとコンパイルエラー、メソッドまたは
データーメンバが見つかりませんと出て来ます。上手く行った方法でも、 Me.予約確認.ListBox1.RowSource = "作業シート!L2:" & R3 'コンパイルエラー Me.ListBox1.RowSource = "作業シート!L2:" & R3 'コンパイルエラー 予約確認.ListBox1.RowSource = "作業シート!L2:" & R3 '動く を入れても上記エラー表示になります。Me.まで入力すると次の候補が出て来ますが、フ ォーム名である 予約確認が出て来ませんでした。でも、Me.を取ると動くのは何か何故なのでしょうか？
ichinose 様
あんなに長いVBAを明記頂き有り難うございました。新規BOOKで"予約変更"と言う保存してみました。
予約確認フォームで選択後、右クリックでポップアップメニューは立ち上がりませんでした。他のフォ
ームでも、試してみましたがポップアップメニューは立ち上がりませんでした。ご参考までに現行フォー ムの上記のデバッグ環境をupしてみました。
ichinose様のVBAが理解出来る程度なら確認作業を出来るのですが。。。。
ichinose 様、 みほりん 様お手数ではございますが、よろしくお願い申し上げます。
失礼しました。2007なんですね？ 提示コードは、未確認ですが2007では、ポップアップメニューは作動しません。
2007なら、ユーザーフォーム上にボタン配置して、修正と削除を行う方法しか思いつきません。
2007の場合は、Class1、Class2は、削除してください。
更に、UserForm1のモジュールを
'===================================================================================
Option Explicit
Private WithEvents lst1 As MSForms.ListBox
Private WithEvents btn_update As MSForms.CommandButton
Private WithEvents btn_del As MSForms.CommandButton
Private Sub btn_del_Click()
If lst1.ListIndex >= 0 Then
Worksheets("sheet1").Rows(lst1.ListIndex + 2).Delete
Call set_listbox
End If
End Sub
'===================================================================================
Private Sub btn_update_Click()
Dim g0 As Long
Dim sht As Worksheet
If lst1.ListIndex >= 0 Then
Load UserForm2
With UserForm2
g0 = lst1.ListIndex
.t_yoyaku.Value = Format(lst1.List(g0, 0), "yy-m-d")
.t_kanryo.Value = Format(lst1.List(g0, 1), "yy-m-d")
.t_user.Value = lst1.List(g0, 2)
.t_genba.Value = lst1.List(g0, 3)
.Show
If .update Then
Set sht = Worksheets("sheet1")
sht.Cells(g0 + 2, 1).Value = CDate(.t_yoyaku.Value)
sht.Cells(g0 + 2, 2).Value = CDate(.t_kanryo.Value)
sht.Cells(g0 + 2, 3).Value = .t_user.Value
sht.Cells(g0 + 2, 4).Value = .t_genba.Value
End If
Call set_listbox
End With
Unload UserForm2
End If
End Sub
'===================================================================================
Private Sub UserForm_Initialize()
Dim rng As Range
With Me
.Width = 450
.Height = 237
.caption = "データメンテナンス"
Set lst1 = .Controls.add("Forms.ListBox.1", , True)
With lst1
.Left = 6
.Top = 6
.Width = 354
.Height = 210
End With
Set btn_update = .Controls.add("Forms.CommandButton.1", , True)
With btn_update
.Left = 370
.Top = 6
.Width = 75
.Height = 30
.Font.Size = 14
.caption = "修正"
End With
Set btn_del = .Controls.add("Forms.CommandButton.1", , True)
With btn_del
.Left = 370
.Top = 40
.Width = 75
.Height = 30
.Font.Size = 14
.caption = "削除"
End With
End With
' ↑ここまでは、本来は、手動操作で設定する
With Worksheets("sheet1")
Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp)).Resize(, 4)
End With
If rng.Row > 1 Then
With lst1
.ColumnHeads = True
.ColumnCount = 4
.RowSource = rng.Address(, , , True)
.TextAlign = fmTextAlignLeft
End With
End If
End Sub
'===================================================================================
Sub set_listbox()
Dim rng As Range
With Worksheets("sheet1")
Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp)).Resize(, 4)
End With
If rng.Row = 1 Then
With lst1
.RowSource = ""
End With
End If
End Sub
Userform2及び、標準モジュールは、変更ナシです。
Userform1に「修正」と「削除」ボタンを追加しました。
リスト内の対象メンバを選択後、修正または、削除ボタンをクリックしてください。
それぞれの機能については、前投稿どおりです。
2007では、確認していませんが・・・。
2003以下なら、先の投稿で作動するはずですけどねえ・・。
尚、私は、Excel2002で確認しています。
ichinose
ichinose 様
こんにちは、まきです。ちなみに私の環境化は2003ですが、配布先のＰＣには2007の人がいます。
前々回ichinose様のマクロをそのままPasteしましたが、何故か動きません。従来のファイルと今
回作ったVBAのbookを立ち上げていても、右クリックにて動作致しませんでした。ちなみにVBAは、
上記の通りです。また、今回の2007変更分でも動作しませんでした。どちらもマクロが動いている様に
見受けられない感じです。（お互いがリンクされていない？？）
昨日色々考えていたのですが、フォームで行うのはやはり難しいのではなかろうかと思い始めました。ブ
ランクのbookを立ち上げ予約状況のみPasteさせ、そこにボタンを配置し（変更と予約キャンセル）デー
ター保存用【予約.xls】に修正データーを書き直す方が簡単かなぁと。でも、エクセル初心者の方もいる
為に、出来るだけフォームにて対応したいと考えております。ichinose様の環境化でよくて、何故私の
ＰＣでは右クリックで立ち上がらないのか不思議です。→最終的には、2007対応で表記頂いた方法で進め
る予定ではいますが。。。
以上よろしくお願い致します。
すでに私では歯が立たないことになっていますし、 理解できない部分も多いので差し出がましいかもしれませんが。 ichinoseさんがコードで実現しようとしていることと、 まきさんが希望していることが合っていない様な気がします。 ichinoseさんの「右クリック」云々は 「すでに表示されているフォーム上の右クリックでポップアップメニュー」ではないかと。 まきさんがやりたいのは 「シート上で右クリックして削除や変更を行なうフォームを表示したい」では？ ichinoseさんは ＞ コードは、以上です。 ＞ mainを実行してみてください。 ^^^^^^^^ とコメントされています。 (みやほりん)(-_∂)b 「みほりん」じゃないよｗｗｗ
>ichinoseさんがコードで実現しようとしていることと、 >まきさんが希望していることが合っていない様な気がします
これが理由なら、みやほりんさんのご指摘どおり、ツール---マクロ---マクロとクリックし、mainを実行するのですよ！！
実際にUserForm1をどのようなタイミングで表示させるか？ は、別の問題だと認識しています。
万が一↑これは、当然そのようにしている ということでしたら・・・、
どこまでは作動しているのか （UserForm1は表示され、サンプルデータはリストボックスに表示されている。が、削除・更新ができない等） を記述してください。
拝見したコードは、Class1のコードが見当たりませんが、それ以外は、正しくコピーされているように 見えます。
ichinose
ichinose様、みやほりん様
おはようございます、まきです。
さて、ichinose様のVBAの動かし方が分からないでいました。ツール---マクロ---マクロとクリックした
所、2007仕様を含め全て動きました。私が動かないと言ったのは、私のフレームで右クリックた所で、
ichinose様のVBAが実行されて、右クリックで別フレームが立ち上げるのだと思い込んでいました。
（下記フレームの状態で、変更したいitemを選択後右クリック）
本来の質問内容から離れてしまった為に、本表題の件はcloseとさせて頂きます。VBAがど素人の私にお付
き合い頂き、お二人には大変感謝しております。今回のVBAは、まだ途中の為、また何か有るかもしれませ
んが、その節には宜しくお願い致します。出来るだけ、自分の力で行ってゆく様努力致します。上記でも
申し上げましたが、私自身営業職で仕事の合間にVBA（アクセスを含め）を作っていますので、とんちん
かんな質問をした事も有ったかと思います。大変申し訳ございませんでした。
有り難うございました。
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.