VBAユーザーフォームのコンパイルエラー

このQ&Aのポイント
  • VBA初心者が作成したユーザーフォームでコンパイルエラーが発生しています。ボタンやスピン移動をクリックすると「コンパイルエラー SubまたはFunctionが定義されていません」というエラーメッセージが表示されます。
  • コードを見たところ、該当のエラーが発生している部分は「データ書き込み」サブルーチンでの「TBL」の部分です。
  • 「TBL」は初期化されていないため、エラーが生じています。TBLの宣言や初期化を行うことでエラーを解消することができます。
回答を見る
  • ベストアンサー

コンパイルエラーSubまたはFunction定義

VBAユーザーフォーム作成の上記エラーについて VBA初心者です。 初心者ですので、本を見ながら作成していましたが、その通り作成したつもりがエラー表示が・・ シート上にユーザーフォームは出てくるようにして入力をしているのですが、ボタン(更新、追加、削除)やスピン移動をクリックすると「コンパイルエラー SubまたはFunctionが定義されていません」とでてきます。本の通りしたので何が悪かったのかよくわからなくなりました。 下記に本を見て作ったコードを書きますので教えて頂きたいです。素人すぎますので説明不足もありますが宜しくお願いします。 Private Sub Button更新_Click() データ書き込み (Spin移動.Value) End Sub Private Sub Button削除_Click() データ範囲.Rows(Spin移動.Value).Delete データ表示 (Spin移動.Value) Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count End Sub Private Sub Button終了_Click() 患者様データ.Hide End Sub Private Sub Button追加_Click() Dim AddRow As Integer AddRow = データ範囲.Rows.Count + 1   データ書き込み (AddRow) Textレコード.Text = Spin移動.Value - 1 & "/" & レコード数取得 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count Spin移動.Value = データ範囲.Rows.Count データ表示 (AddRow) End Sub Private Sub MultiPage1_Change() End Sub Private Sub Option女_Click() End Sub Private Sub Option男_Click() End Sub Private Sub Spin移動_Change() If データ範囲.Rows.Count <> 1 Then データ表示 (Spin移動.Value) End If End Sub Private Sub TextIIIIV音_Change() End Sub Private Sub Text患者ID_Change() End Sub Private Sub Text生年月日_AfterUpdate() Text年齢.Value = DateDiff("yyyy", Text生年月日.Value, Now()) End Sub Private Sub UserForm_Initialize() Dim TBL(1 To 9) As Control Dim データ範囲 As Range Combo診療科.ColumnCount = 1 Combo診療科.AddItem "内科" Combo診療科.AddItem "外科" Combo診療科.AddItem "小児科" Combo主治医.ColumnCount = 1 Combo主治医.AddItem "今中尚子" Combo主治医.AddItem "岡井康葉" Set TBL(1) = Text患者ID Set TBL(2) = Text氏名 Set TBL(3) = Text生年月日 Set TBL(4) = Frame性別 Set TBL(5) = Combo診療科 Set TBL(6) = Combo主治医 Set TBL(7) = Text入院日 Set TBL(8) = Text退院日 Set TBL(9) = Combo指導医 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = レコード数取得 + 1 If データ範囲.Rows.Count = 1 Then Else データ表示 2 End If End Sub Public Sub データ表示(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 9 Select Case Cnt Case 4 If データ範囲.Cells(行数, Cnt).Value = "男" Then Option男.Value = True Else Option女.Value = True End If Case Else Dim S For Cnt = 1 To 9 S = データ範囲cells(行数, Cnt).Value Next End Select Next If IsDate(Text生年月日.Text) Then Text年齢.Value = DateDiff("yyyy", Text生年月日.Value, Now()) Else Text年齢.Value = Null End If Textレコード.Value = Spin移動.Value - 1 & "/" & レコード数取得 End Sub Public Sub データ書き込み(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 9 Select Case Cnt Case 4 If Option男.Value = True Then データ範囲.Cells(行数, Cnt).Value = "男" Else データ範囲.Cells(行数, Cnt).Value = "女" End If Case Else データ範囲.Cells(行数, Cnt).Value = TBL(Cnt).Value ←このTBLの部分で青くなり上記エラー End Select Next End Sub Public Function レコード数取得() As Integer レコード数取得 = Range("A1").CurrentRegion.Rows.Count - 1 End Function

質問者が選んだベストアンサー

  • ベストアンサー
  • nag0720
  • ベストアンサー率58% (1093/1860)
回答No.1

変数の使い方が間違っています。 変数は、それを定義したSubまたはFunctionの中でしか有効ではありません。 このプログラムで言えば、 Private Sub UserForm_Initialize() Dim TBL(1 To 9) As Control Dim データ範囲 As Range ・・・・ End Sub なので、TBLやデータ範囲の変数が使えるのは Sub UserForm_Initialize の中だけです。 どうしてもUserForm_Initializeの外で使いたいなら、 パブリック変数にする必要があります。

shinarika
質問者

お礼

ご丁寧にありがとうございました。

関連するQ&A

  • コンパイルエラーSubまたはFunction定義

    VBAユーザーフォーム作成の上記エラーについて VBA初心者です。 初心者ですので、本を見ながら作成していましたが、その通り作成したつもりがエラー表示が・・ シート上にユーザーフォームは出てくるようにして入力をしているのですが、ボタン(更新、追加、削除)やスピン移動をクリックすると「コンパイルエラー SubまたはFunctionが定義されていません」とでてきます。本の通りしたので何が悪かったのかよくわからなくなりました。 下記に本を見て作ったコードを書きますので教えて頂きたいです。素人すぎますので説明不足もありますが宜しくお願いします。 Private Sub Button更新_Click() データ書き込み (Spin移動.Value) End Sub Private Sub Button削除_Click() データ範囲.Rows(Spin移動.Value).Delete データ表示 (Spin移動.Value) Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count End Sub Private Sub Button終了_Click() 患者様データ.Hide End Sub Private Sub Button追加_Click() Dim AddRow As Integer AddRow = データ範囲.Rows.Count + 1   データ書き込み (AddRow) Textレコード.Text = Spin移動.Value - 1 & "/" & レコード数取得 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count Spin移動.Value = データ範囲.Rows.Count データ表示 (AddRow) End Sub Private Sub MultiPage1_Change() End Sub Private Sub Option女_Click() End Sub Private Sub Option男_Click() End Sub Private Sub Spin移動_Change() If データ範囲.Rows.Count <> 1 Then データ表示 (Spin移動.Value) End If End Sub Private Sub TextIIIIV音_Change() End Sub Private Sub Text患者ID_Change() End Sub Private Sub Text生年月日_AfterUpdate() Text年齢.Value = DateDiff("yyyy", Text生年月日.Value, Now()) End Sub Private Sub UserForm_Initialize() Dim TBL(1 To 9) As Control Dim データ範囲 As Range Combo診療科.ColumnCount = 1 Combo診療科.AddItem "内科" Combo診療科.AddItem "外科" Combo診療科.AddItem "小児科" Combo主治医.ColumnCount = 1 Combo主治医.AddItem "今中尚子" Combo主治医.AddItem "岡井康葉" Set TBL(1) = Text患者ID Set TBL(2) = Text氏名 Set TBL(3) = Text生年月日 Set TBL(4) = Frame性別 Set TBL(5) = Combo診療科 Set TBL(6) = Combo主治医 Set TBL(7) = Text入院日 Set TBL(8) = Text退院日 Set TBL(9) = Combo指導医 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = レコード数取得 + 1 If データ範囲.Rows.Count = 1 Then Else データ表示 2 End If End Sub Public Sub データ表示(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 9 Select Case Cnt Case 4 If データ範囲.Cells(行数, Cnt).Value = "男" Then Option男.Value = True Else Option女.Value = True End If Case Else Dim S For Cnt = 1 To 9 S = データ範囲cells(行数, Cnt).Value Next End Select Next If IsDate(Text生年月日.Text) Then Text年齢.Value = DateDiff("yyyy", Text生年月日.Value, Now()) Else Text年齢.Value = Null End If Textレコード.Value = Spin移動.Value - 1 & "/" & レコード数取得 End Sub Public Sub データ書き込み(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 9 Select Case Cnt Case 4 If Option男.Value = True Then データ範囲.Cells(行数, Cnt).Value = "男" Else データ範囲.Cells(行数, Cnt).Value = "女" End If Case Else データ範囲.Cells(行数, Cnt).Value = TBL(Cnt).Value ←このTBLの部分で青くなり上記エラー End Select Next End Sub Public Function レコード数取得() As Integer レコード数取得 = Range("A1").CurrentRegion.Rows.Count - 1 End Function

  • ユーザーフォームがエラーになってしまって困っています。

    VBA初心者なので、テキスト本を参考にユーザーフォームを作ったのですが、エラーになってしまって困っています。 フォーム上のコンボボックス、テキストボックスに入力した値をワークシート上に転記したいのですがエラーが出てしまって先に進めずに困っています。 どなたかお力をお貸し頂けませんでしょうか? Option Explicit Dim TBL(1 To 8) As Control Dim データ範囲 As Range ---------------------------- Private Sub UserForm_Initialize() With Combo会社名 .MatchEntry = fmMatchEntryFirstLetter .ColumnCount = 2 .TextColumn = 1 End With With Combo住所1 .AddItem "東京都" .AddItem "埼玉県" .AddItem "神奈川県" End With Set TBL(1) = Textコード番号 Set TBL(2) = Text登録年月日 Set TBL(3) = Combo住所1 Set TBL(4) = Combo会社名 Set TBL(5) = Text郵便番号 Set TBL(6) =Text住所2 Set TBL(7) = Text 住所3 Set TBL(8) = Text電話番号 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = レコード数取得 + 1 If データ範囲.Rows.Count = 1 Then Else データ表示 2 End If End Sub ---------------------------------------- Public Function レコード数取得() As Integer レコード数取得 = Range("A1").CurrentRegion.Rows.Count - 1 End Function ---------------------------------------- Public Sub データ表示(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 19 TBL(Cnt).Value = データ範囲.Cells(行数, Cnt).Value  ---この部分でエラー Next Textレコード.Value = Spin移動.Value - 1 & "/" & レコード数取得 End Sub ------------------------------------- Private Sub Spin移動_Change() If データ範囲.Rows.Count <> 1 Then データ表示 (Spin移動.Value) End If End Sub ------------------------------------ Private Sub Button追加_Click() Dim AddRow As Integer AddRow = データ範囲.Rows.Count + 1 データ書き込み (AddRow) Textレコード.Text = Spin移動.Value - 1 & "/" & レコード数取得 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count Spin移動.Value = データ範囲.Rows.Count データ表示 (AddRow) End Sub ------------------------------------- Private Sub Button更新_Click() データ書き込み (Spin移動.Value) End Sub ------------------------------------- Public Sub データ書き込み(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 19 データ範囲.celles(行数, Cnt).Value = TBL(Cnt).Value Next End Sub -------------------------------------- Private Sub Button終了_Click() ActiveWorkbook.Save Application.DisplayAlerts = False Unload Me ActiveWorkbook.Close Application.Quit End Sub

  • VBAユーザーフォーム作成のエラーについて

    VBA初心者です。 初心者ですので、本を見ながら作成していましたが、その通り作成したつもりがエラー表示が・・ シート上にユーザーフォームは出てくるようにして入力をしているのですが、ボタン(更新、追加、削除)やスピン移動をクリックすると「実行時エラー”424”オブジェクトが必要です”とでてきます。本の通りしたので何が悪かったのかよくわからなくなりました。 下記に本を見て作ったコードを書きますので教えて頂きたいです。素人すぎますので説明不足もありますが宜しくお願いします。 Private Sub Button更新_Click() データ書き込み (Spin移動.Value) End Sub Private Sub Button削除_Click() データ範囲.Rows(Spin移動.Value).Delete データ表示 (Spin移動.Value) Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count End Sub Private Sub Button終了_Click() 患者様データ.Hide End Sub Private Sub Button追加_Click() Dim AddRow As Integer AddRow = データ範囲.Rows.Count + 1   ←この部分でエラー データ書き込み (AddRow) Textレコード.Text = Spin移動.Value - 1 & "/" & レコード数取得 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count Spin移動.Value = データ範囲.Rows.Count データ表示 (AddRow) End Sub Private Sub MultiPage1_Change() End Sub Private Sub Option女_Click() End Sub Private Sub Option男_Click() End Sub Private Sub Spin移動_Change() If データ範囲.Rows.Count <> 1 Then データ表示 (Spin移動.Value) End If End Sub Private Sub TextIIIIV音_Change() End Sub Private Sub Text患者ID_Change() End Sub Private Sub Text生年月日_AfterUpdate() Text年齢.Value = DateDiff("yyyy", Text生年月日.Value, Now()) End Sub Private Sub UserForm_Initialize() Dim TBL(1 To 9) As Control Dim データ範囲 As Range Combo診療科.ColumnCount = 1 Combo診療科.AddItem "内科" Combo診療科.AddItem "外科" Combo診療科.AddItem "小児科" Combo主治医.ColumnCount = 1 Combo主治医.AddItem "今中尚子" Combo主治医.AddItem "岡井康葉" Set TBL(1) = Text患者ID Set TBL(2) = Text氏名 Set TBL(3) = Text生年月日 Set TBL(4) = Frame性別 Set TBL(5) = Combo診療科 Set TBL(6) = Combo主治医 Set TBL(7) = Text入院日 Set TBL(8) = Text退院日 Set TBL(9) = Combo指導医 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = レコード数取得 + 1 If データ範囲.Rows.Count = 1 Then Else データ表示 2 End If End Sub Public Sub データ表示(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 9 Select Case Cnt Case 4 If データ範囲.Cells(行数, Cnt).Value = "男" Then Option男.Value = True Else Option女.Value = True End If Case Else Dim S For Cnt = 1 To 9 S = データ範囲cells(行数, Cnt).Value Next End Select Next If IsDate(Text生年月日.Text) Then Text年齢.Value = DateDiff("yyyy", Text生年月日.Value, Now()) Else Text年齢.Value = Null End If Textレコード.Value = Spin移動.Value - 1 & "/" & レコード数取得 End Sub Public Sub データ書き込み(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 9 Select Case Cnt Case 4 If Option男.Value = True Then データ範囲.Cells(行数, Cnt).Value = "男" Else データ範囲.Cells(行数, Cnt).Value = "女" End If Case Else データ範囲.Cells(行数, Cnt).Value = TBL(Cnt).Value End Select Next End Sub Public Function レコード数取得() As Integer レコード数取得 = Range("A1").CurrentRegion.Rows.Count - 1 End Function

  • アプリケーションまたはオブジェクト定義のエラーです

    データを入力するシート「input]、データを格納するシート 「data」とがあり、 新規のレコードを追加入力するために 新規入力ボタン(CommandButton2)を作成しましたが、 実行しようとすると、表記のエラーが出てしまします。 コードの確認、とそして、どこがいけないのかをご指摘いただけないでしょうか?どうかよろしくお願いいたします。 以下コードです。 Private Sub CommandButton2_Click() '新規入力 Dim row As Integer row = Sheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1) Sheets("data").Cells(row, 2).Value = Sheets("data").Cells(row - 1, 2).Value Range("AL1") = Sheets("data").Cells(row, 2).Value End Sub

  • Excel VBA ユーザフォームの検索について

    添付の画像のようなユーザフォームを作っています。 TextBox1に検索ワードを入力して、CommandButton1をクリックすると、下のComboBox1に一覧が出るようにしたいと思い、ほかのサイトから下記のコードを見つけて、作ってみました。参照先のsheet2を表示しているときは大丈夫なのですが、別のシートを選んでいるとエラーになります。 sheetは3つあり、それぞれ違うリストが入力されています。今回はsheet2のリストを参照したいのですが、最初はsheet1が表示されている状態で実行したいです。 エラーの内容は 実行時エラー9 インデックスが有効範囲にありません。 コチラがコードです。 Private Sub UserForm_Initialize() Dim i As Long, imax As Long Dim tbl() As Variant imax = ThisWorkbook.Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row ReDim tbl(imax) For i = 1 To imax tbl(i) = Range("A" & i).Value Next i With ComboBox1 .List() = tbl() End With End Sub Private Sub CommandButton1_Click() Dim i As Long, imax As Long Dim tbl() As Variant Dim cnt As Long, j As Long j = -1 With ThisWorkbook.Worksheets("sheet2") imax = .Cells(Rows.Count, "A").End(xlUp).Row cnt = Application.CountIf(Range("A1:A" & imax), "*" & TextBox1.Text & "*") ReDim tbl(cnt) For i = 1 To imax If InStr(.Range("A" & i), TextBox1.Text) > 0 Then j = j + 1 tbl(j) = Range("A" & i).Value ←この部分がエラーになる End If Next i End With With ComboBox1 .List() = tbl() End With End Sub どこを直せば良いか、教えてください。 よろしくお願いします。

  • 【続】VBSでメール件数カウント(サブフォルダ有)

    「VBSでメール件数カウント」の続きなのですが、 「受信フォルダ」の下にサブフォルダがあった場合の、 件数カウントはどうすればよいでしょうか? 試しに作ってみましたのですが、自信がないので、 よろしければ診ていただけないでしょうか? ------------------------------------------------------------ Private Function Cnt_MailItem Cnt_MailItem = 0 Set oApp = CreateObject("Outlook.Application") Set oNs = oApp.GetNameSpace("MAPI") Set oFol = oNs.GetDefaultFolder(6) '受信アイテイム Cnt_MailItem = oFol.Items.Count 'サブフォルダカウント Cnt_MailItem = Cnt_MailItem + Cnt_SubFol(oFol) msgbox "メール数:" & Cnt_MailItem End Function 'サブカウント Private Function Cnt_SubFol(byVal pFol ) 'サブがない場合は数えない If pFol.Folders.Count <= 0 Then Exit Function End If For i = 1 To pFol.Folders.Count Set oItems = pFol.Folders.Item(i) Cnt_SubFol = Cnt_SubFol + oItems.Items.Count + Cnt_SubFol(oItems) next Set oItems = Nothing End Function ------------------------------------------------------------ よろしくお願い致します。

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • エクセル追記処理でエラー

    別のフォームで前の処理が既に書き込まれているエクセルシートに、 新たに処理結果を追記していきたいのですが、 「オブジェクトがありません」というエラーになってしまいます。 Setをどのように書けばよいのでしょうか。 Private Sub Command1_Click() Set xlApp = CreateObject("Excel.Application") xlFileName = strFileName Set xlBook = xlApp.Workbooks.Open(xlFileName) Set xlNeosheet = xlBook.Sheets.Item(1) Set Newsheet ★ここがわかりません n = 1 cnt = 0 rowNum = xlNeosheet.Range("A1").CurrentRegion.Rows.Count For i = 1 To rowNum shusseki = xlNeosheet.Cells(i, 5).Value If IsNumeric(shusseki) Then stno = xlNeosheet.Cells(i, 1) stno = Form7.Text1 & stno xlNewsheet.Cells(n, 6) = stno ☆ここでエラー n = n + 1 cnt = cnt + 1 For j = 2 To 5 xlNewsheet.Cells(cnt, j + 5).Value = xlNeosheet.Cells(i, j).Value Next j End If Next i 必要な部分だけ載せました。 よろしくお願いします。

  • vb コンボボックスのイベントについて

    こんばんわ。 コンボボックスで、 指定の値をマウス操作でクリックしたときと、 キーボードの上下で、移動後returnを押したときだけ、 MsgBox "処理実行" を実行したいです。 keystateを使ってみたのですが、前の情報が残っているのかうまくいきません。keystateの情報をクリアさせるか、シンプルに上記を動作させる何かよい方法はありますでしょうか。 Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Dim flg1 As Boolean Private Sub form_load() Combo1.AddItem (11) Combo1.AddItem (22) Combo1.AddItem (33) Combo1.AddItem (44) End Sub Private Sub Combo1_Keyup(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then 'return flg1 = True Call Combo1_click End If End Sub Private Sub Combo1_click() If (GetKeyState(&H26) <> 0) Or (GetKeyState(&H28) <> 0) Then ' ↑↓ If flg1 = False Then Exit Sub End If End If MsgBox "処理実行" flg1 = False End Sub

  • エクセルVBAでスピンボタン

    ワークシート上にスピンボタンを配置しました。 Valueは、Max100、Min0 で設定しました。 やりたいのは、スピンボタンでValueを減らしていって、0になるまでは何も言わず、Valueが0の状態でさらに減らそうとした場合、メッセージを出したいのです。 Private Sub SpinButton1_Change() If SpinButton1 <= 0 Then MsgBox "マイナスにはできません!", vbCritical End If End Sub としましたら、0になった瞬間にメッセージがでてしまいます。 If SpinButton1 < 0 Then としたら、マイナスにはならないので当たり前ですが何も出ません。 どうしたらいいでしょうか?

専門家に質問してみよう