●質問の主旨
ComboBox3で選択した文字列によって、参照するワークシートを
変え、そのワークシートからComboBox4に代入するには、以下の
コードをどのように書き換えればよいでしょうか？
ご教示願います。
●質問の補足
添付画像でComboBox3に「営業」、「技術」、「総務」まで
入力することによってそれぞれ３つのワークシートを参照
させたいと考えています。
・「営業」→中分類（営業）シート
・「技術」→中分類（技術）シート
・「総務」→中分類（総務）シート
そして各シートにはそれぞれ異なった仕事内容の表が
既に作成されています。もしComboBox3で「営業」を
選択したなら、ComboBox4で中分類（営業）シートに
記載されている仕事内容を選択できるようにしたいと
考えています。
そのためSelect Caseステートメントを使って
ComboBox3の内容によってComboBox4の内容を変える
コードを作成したつもりです。
●現在の問題点
１．下記のコードを実行しようとすると、
「実行時エラー91
オブジェクト変数またはWithブロック変数が設定されていません」
というエラーが返されます。
２．デバックするとユーザーフォームではなく、
標準モジュールの2行目
UserForm1.Show
が黄色くなります。
●コード
（標準モジュール）
Sub 日報記入ダイアログ()
UserForm1.Show
End Sub
（ユーザーフォーム）
Option Explicit
Private Sub ComboBox4_Change()
End Sub
'ユーザーフォームの初期化
Private Sub UserForm_Initialize()
Dim r As Range
Dim n As Range
Dim d As Range
Dim t As Range
With Worksheets(2)
Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = ";0"
.List = r.Value
End With
With Worksheets(3)
Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = ";0"
.List = n.Value
End With
With Worksheets(4)
Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox3
.ColumnCount = 2
.ColumnWidths = ";0"
.List = d.Value
End With
'中分類のComboBox4は「大分類」の選択内容によって参照するワークシートが変わる
Select Case t
Case Is = ComboBox3("営業")
With Worksheets(5)
Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox4
.ColumnCount = 2
.ColumnWidths = ";0"
.List = t.Value
End With
Case Is = ComboBox3("技術")
With Worksheets(6)
Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox4
.ColumnCount = 2
.ColumnWidths = ";0"
.List = t.Value
End With
Case Is = ComboBox3("総務")
With Worksheets(7)
Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox4
.ColumnCount = 2
.ColumnWidths = ";0"
.List = t.Value
End With
End Select
'メモリの解放
Set r = Nothing
Set n = Nothing
Set d = Nothing
Set t = Nothing
'その他の初期値
TextBox3.Value = Worksheets(1).Range("a10000").End(xlUp).Row
txtdate = Date
End Sub
'ComboBox1をクリックしたときの処理
Private Sub ComboBox1_Click()
With Me.ComboBox1
Me.Label19.Caption = .List(.ListIndex, 1)
End With
End Sub
'ComboBox2をクリックしたときの処理
Private Sub ComboBox2_Click()
With Me.ComboBox2
Me.Label20.Caption = .List(.ListIndex, 1)
End With
End Sub
'ComboBox2をクリックしたときの処理(中分類の仕事によってスターマークが変わる）
'フォームからデータベースへの転記
Private Sub CommandButton3_Click()
Dim Rowpos As Long
Dim ColPos As Long
Rowpos = Worksheets(1).Range("a10000").End(xlUp).Row
ColPos = 1
Rowpos = Rowpos + 1
With Worksheets(1)
.Cells(Rowpos, ColPos) = TextBox3.Value
.Cells(Rowpos, ColPos + 1) = txtdate.Value
.Cells(Rowpos, ColPos + 2) = Label19.Caption
.Cells(Rowpos, ColPos + 3) = ComboBox1.Text
.Cells(Rowpos, ColPos + 4) = ComboBox2.Text
.Cells(Rowpos, ColPos + 5) = Label20.Caption
.Cells(Rowpos, ColPos + 6) = ComboBox3.Text
End With
'Noの加算
TextBox3.Value = TextBox3.Value + 1
Call Clearcmb
End Sub
'データベース入力後にコンボボックスを空欄にする
Private Sub Clearcmb()
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
End Sub
'ユーザーフォームの終了
Private Sub CommandButton5_Click()
Unload UserForm1
End
End Sub
以上よろしくお願い申し上げます。使用機種はWindowsVistaで、
Excel2007です。私はVBA初心者です。添付の画像でのユーザーフォームは
プリントスクリーンでWorksheet(1)に貼り付けています。
●質問の主旨
ComboBox3で選択した文字列によって、参照するワークシートを
変え、そのワークシートからComboBox4に代入するには、以下の
コードをどのように書き換えればよいでしょうか？
ご教示願います。
●質問の補足
添付画像でComboBox3に「営業」、「技術」、「総務」まで
入力することによってそれぞれ３つのワークシートを参照
させたいと考えています。
・「営業」→中分類（営業）シート
・「技術」→中分類（技術）シート
・「総務」→中分類（総務）シート
そして各シートにはそれぞれ異なった仕事内容の表が
既に作成されています。もしComboBox3で「営業」を
選択したなら、ComboBox4で中分類（営業）シートに
記載されている仕事内容を選択できるようにしたいと
考えています。
そのためSelect Caseステートメントを使って
ComboBox3の内容によってComboBox4の内容を変える
コードを作成したつもりです。
●現在の問題点
１．下記のコードを実行しようとすると、
「実行時エラー91
オブジェクト変数またはWithブロック変数が設定されていません」
というエラーが返されます。
２．デバックするとユーザーフォームではなく、
標準モジュールの2行目
UserForm1.Show
が黄色くなります。
●コード
（標準モジュール）
Sub 日報記入ダイアログ()
UserForm1.Show
End Sub
（ユーザーフォーム）
Option Explicit
Private Sub ComboBox4_Change()
End Sub
'ユーザーフォームの初期化
Private Sub UserForm_Initialize()
Dim r As Range
Dim n As Range
Dim d As Range
Dim t As Range
With Worksheets(2)
Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = ";0"
.List = r.Value
End With
With Worksheets(3)
Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = ";0"
.List = n.Value
End With
With Worksheets(4)
Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox3
.ColumnCount = 2
.ColumnWidths = ";0"
.List = d.Value
End With
'中分類のComboBox4は「大分類」の選択内容によって参照するワークシートが変わる
Select Case t
Case Is = ComboBox3("営業")
With Worksheets(5)
Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox4
.ColumnCount = 2
.ColumnWidths = ";0"
.List = t.Value
End With
Case Is = ComboBox3("技術")
With Worksheets(6)
Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox4
.ColumnCount = 2
.ColumnWidths = ";0"
.List = t.Value
End With
Case Is = ComboBox3("総務")
With Worksheets(7)
Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox4
.ColumnCount = 2
.ColumnWidths = ";0"
.List = t.Value
End With
End Select
'メモリの解放
Set r = Nothing
Set n = Nothing
Set d = Nothing
Set t = Nothing
'その他の初期値
TextBox3.Value = Worksheets(1).Range("a10000").End(xlUp).Row
txtdate = Date
End Sub
'ComboBox1をクリックしたときの処理
Private Sub ComboBox1_Click()
With Me.ComboBox1
Me.Label19.Caption = .List(.ListIndex, 1)
End With
End Sub
'ComboBox2をクリックしたときの処理
Private Sub ComboBox2_Click()
With Me.ComboBox2
Me.Label20.Caption = .List(.ListIndex, 1)
End With
End Sub
'ComboBox2をクリックしたときの処理(中分類の仕事によってスターマークが変わる）
'フォームからデータベースへの転記
Private Sub CommandButton3_Click()
Dim Rowpos As Long
Dim ColPos As Long
Rowpos = Worksheets(1).Range("a10000").End(xlUp).Row
ColPos = 1
Rowpos = Rowpos + 1
With Worksheets(1)
.Cells(Rowpos, ColPos) = TextBox3.Value
.Cells(Rowpos, ColPos + 1) = txtdate.Value
.Cells(Rowpos, ColPos + 2) = Label19.Caption
.Cells(Rowpos, ColPos + 3) = ComboBox1.Text
.Cells(Rowpos, ColPos + 4) = ComboBox2.Text
.Cells(Rowpos, ColPos + 5) = Label20.Caption
.Cells(Rowpos, ColPos + 6) = ComboBox3.Text
End With
'Noの加算
TextBox3.Value = TextBox3.Value + 1
Call Clearcmb
End Sub
'データベース入力後にコンボボックスを空欄にする
Private Sub Clearcmb()
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
End Sub
'ユーザーフォームの終了
Private Sub CommandButton5_Click()
Unload UserForm1
End
End Sub
以上よろしくお願い申し上げます。使用機種はWindowsVistaで、
Excel2007です。私はVBA初心者です。添付の画像でのユーザーフォームは
プリントスクリーンでWorksheet(1)に貼り付けています。
●質問の主旨
データベースにデータを入力していくたびに
そのデータに「入力No.」1を振り、以後データが増えるたびに
番号を1つずつ増やしていきたいと考えています。
A2→1
A3→2
A4→3
A5→4
という具合に、途中でブックを保存して再度立ち上げても
常に連続した数字を入力したいと思っています。
以下のコードをどのように書き改めばよいでしょうか？
ご教示願います。
●現在の問題点
１．「データベース入力」のボタンを押すと
A2セルに「入力No.」2が入力されてしまう
２．ブックを閉じない限り、入力した番号は
2のままで転記されてしまう。
３.ブックを保存して閉じた後、再度立ち上げ「入力No.」を
入力しようとすると今度は4が入力される。
４．その後はブックを保存して閉じた後、再度立ち上げても
4が入力され続ける。
●コード
Option Explicit
'ユーザーフォームの初期化
Private Sub UserForm_Initialize()
TextBox3.Value = Worksheets(1).Range("A2").Value + 1
txtdate = Date
Call No
End Sub
'フォームからデータベースへの転記
Private Sub CommandButton3_Click()
Dim Rowpos As Long
Dim ColPos As Long
Rowpos = Worksheets(1).Range("a10000").End(xlUp).Row
ColPos = 1
Rowpos = Rowpos + 1
With Worksheets(1)
.Cells(Rowpos, ColPos) = TextBox3.Value
.Cells(Rowpos, ColPos + 1) = txtdate.Value
End With
End Sub
'Noの加算
Private Sub No()
Dim i As Long
For i = 1 To 1 Step 1
TextBox3.Value = TextBox3.Value + 1
Next
End Sub
'ユーザーフォームの終了
Private Sub CommandButton5_Click()
Unload UserForm1
End
End Sub
以上よろしくお願い申し上げます。使用機種はWindowsVistaで、
Excel2007です。私はVBA初心者です。
●質問の主旨
WorkSheet(1)（「柴田8月分」）にユーザーフォームを固定的に
表示させつつ、WorkSheet(1)以降のWorkSheet(2）、
WorkSheet(3）、WorkSheet(4）の表を参照しながら
ComboBox1、ComboBox2、ComboBox3にリストを
選択して、データベースに入力したいと考えています。
以下のコードをどのように書き換えれば良いでしょうか？
ご教示のほどよろしくお願い申し上げます。
●質問の補足
現在のコードでは、ComboBox1、ComboBox2、ComboBox3を
それぞれ選択しているとユーザーフォームがそれぞれ
WorkSheet(2）、WorkSheet(1)（顧客リスト）、WorkSheet(3）（社員名）、
WorkSheet(4）（大分類）にとんでしまいます。
転記入力が終了すると、また手作業でWorkSheet(1)に戻らなければなりません。
その手作業を回避したいと考えています。
なお添付画像はComboBox1の選択前なのでWorkSheet(1)
に留まってくれています。
●コード
Option Explicit
'ユーザーフォームの初期化
Private Sub UserForm_Initialize()
Dim r As Range
Dim n As Range
Dim d As Range
With Worksheets(2)
Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = ";0"
.List = r.Value
End With
With Worksheets(3)
Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = ";0"
.List = n.Value
End With
With Worksheets(4)
Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Me.ComboBox3
.ColumnCount = 2
.ColumnWidths = ";0"
.List = d.Value
End With
Set r = Nothing
Set n = Nothing
Set d = Nothing
TextBox3.Value = Worksheets(1).Range("A2").Value + 1
txtdate = Date
OptionButton1.Value = True
End Sub
'ComboBox1をクリックしたときの処理
Private Sub ComboBox1_Click()
Worksheets(2).Select
With Me.ComboBox1
Me.Label19.Caption = .List(.ListIndex, 1)
Worksheets(2).Select Replace:=False
End With
End Sub
'ComboBox2をクリックしたときの処理
Private Sub ComboBox2_Click()
Worksheets(3).Select
With Me.ComboBox2
Me.Label20.Caption = .List(.ListIndex, 1)
Worksheets(3).Select Replace:=False
End With
End Sub
'フォームからデータベースへの転記
Private Sub CommandButton3_Click()
Dim Rowpos As Long
Dim ColPos As Long
Rowpos = Worksheets("柴田8月分").Range("a10000").End(xlUp).Row
ColPos = 1
Rowpos = Rowpos + 1
With Worksheets("柴田8月分")
.Cells(Rowpos, ColPos) = TextBox3.Value
.Cells(Rowpos, ColPos + 1) = txtdate.Value
.Cells(Rowpos, ColPos + 2) = Label19.Caption
.Cells(Rowpos, ColPos + 3) = ComboBox1.Text
.Cells(Rowpos, ColPos + 4) = ComboBox2.Text
.Cells(Rowpos, ColPos + 5) = Label20.Caption
.Cells(Rowpos, ColPos + 6) = ComboBox3.Text
End With
'Noの加算
Dim i As Long
For i = 1 To 1 Step 1
TextBox3.Value = TextBox3.Value + 1
Next
Call Clearcmb
End Sub
'データベース入力後にコンボボックスを空欄にする
Private Sub Clearcmb()
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
End Sub
'ユーザーフォームの終了
Private Sub CommandButton5_Click()
Unload UserForm1
End
End Sub
以上よろしくお願い申し上げます。使用機種はWindowsVistaで、
Excel2007です。私はVBA初心者です。
こんばんわ！
エクセルのVBAを使った管理システムを作ろうと思うのですが、色々考えて下記のような状態にしてみたのですが、ユーザーフォームをモードレスにするとスタック容量が足りなくなります。
Sub aaa_date()
If Range("a1") = 1 Then
bbb_date.Show
ElseIf Range("a1") = 2 Then
ccc_date.Show
ElseIf Range("a1") = 3 Then
ddd_date.Show
End If
Call aaa_date
End Sub
bbb_date（ユーザーフォーム）に↓
Private Sub CommandButton1_Click()
Range("a1") = 2
Unload Me
End Sub
Private Sub CommandButton2_Click()
Range("a1") = 3
Unload Me
End Sub
ccc_date（ユーザーフォーム）に↓
Private Sub CommandButton1_Click()
Range("a1") = 1
Unload Me
End Sub
Private Sub CommandButton2_Click()
Range("a1") = 3
Unload Me
End Sub
ddd_date（ユーザーフォーム）に↓
Private Sub CommandButton1_Click()
Range("a1") = 1
Unload Me
End Sub
Private Sub CommandButton2_Click()
Range("a1") = 2
Unload Me
End Sub
※bbb_dateとccc_dateとddd_dateはそれぞれにあるボタンを押すとA7セルの値を変更するようにして、aaa_dateでどのフォームを表示するのかを選択しています。
※実際にはもっと沢山ユーザーフォームがあります。
上記の状態では動作するのですが、エクセルの表に値を入力したいので、bbb_dateとccc_datとddd_datをvbModeless（モードレス状態）にすると、スタック容量が足りませんと出ます。
別のやり方でもよいですので、ユーザーフォームを切り替える良い方法があったらお願いします。
例えば、11.jpg～79.jpgの画像を読み込むとします。
これをvbaで記述すると
j & i & ".jpg"
となります（1の位と10の位の数字は独立していると考えてください）
これを、1-1.jpg～7-9.jpg といった形式をvbaで記述すると、
j & "-"& i & ".jpg"
となります。
これをvbaで記述させるときに、これをA1のセルに「ji」や、「j-i」や、「i」、「j」と入力させたときに様々なパターンに対応させたいと考えております。
（他の方法でもいいです。やりたいことは、複数パターンのファイル名に対応させたいという事です。）
いちいち、写真のファイル名のパターンが違うたびにコード書き直すのも面倒ですし、プログラムわからない人には読み込ませることすらできないです。
4パターンだったら、if文で分けちゃえば？という人もいるでしょうが、それは最終手段として残しておきたいです（プログラムがえらい長くなり、後々の修正が大変だし、パターンが増えるたび追加しなければならないので）
せめて、C言語のように#defineによる置き換えができれば、
#define PATARN j & "-"& i
として、「一か所のみ修正すれば楽ちん」みたいなことができればいいんですけれども、
VBAで、C言語の#defineに該当するものが何かよくわかりません。
(プログラム本文にはPATARNに該当する箇所が何か所かあるので、修正が大変なんです）
もし必要ならと思い、ソースの一部を書いておきます（主要なところだけ残して、後はざっくり削除しています）
やってることは、写真を挿入して、規則的に並べて、JPEG変換しています
（下のコードは写真の挿入のみ）
Sub 写真挿入→JPEG変換()
On Error Resume Next
Dim flag As Integer
Dim xoffset As Integer
Dim yoffset As Integer
Dim Ystart As Integer
Dim i As Integer
Dim j As Integer
Dim Xstart As Integer
Dim str As String
Dim Er As String
Xstart = 1
Dim Xend As Integer
Dim Yend As Integer
flag = 0
xoffset = 1
yoffset = 1
Ystart = 1
Yend = 6
Xend = 6
Application.ScreenUpdating = False
For j = Xstart To Xend
For i = Ystart To Yend
ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & _
j & i & ".jpg").Select
If i = Yend Then
Else
If flag = 0 Then
ActiveCell.Offset(yoffset, 0).Range("A1").Select
ElseIf flag = 1 Then
ActiveCell.Offset(0, xoffset).Range("A1").Select
End If
End If
Next
If flag = 0 Then
ActiveCell.Offset(-(Yend - Ystart) * yoffset, xoffset).Range("A1").Select
ElseIf flag = 1 Then
ActiveCell.Offset(yoffset, -(Yend - Ystart) * xoffset).Range("A1").Select
End If
Next
Application.ScreenUpdating = True
End Sub
よろしくお願いします。
Sub test()
Dim a As Range
If a Is Nothing Then MsgBox "1:nothing" '表示する
Set a = Range("C3")
If a Is Nothing Then MsgBox "2:nothing" '表示しない
MsgBox a.Row '表示する
a.Delete shift:=xlUp
If a Is Nothing Then MsgBox "3:nothing" '表示しない
MsgBox a.Row 'エラーになる
End Sub
知りたいのはaをdeleteしたことをif文で検出したいのです。どうすればいいのでしょうか。
（setしたあとでdeleteしても既にそれはnothingではありません。set a=nothing をa.Delete shift:=xlUp のあとに挿入すれば、3:nothingは表示します。しかし、今したいのは、deleteしたことを検知することです。）(on error goto を使わずに処理したいです。)
よろしくお願いします。
Sub test()
Dim a As Range
If a Is Nothing Then MsgBox "1:nothing" '表示する
Set a = Range("C3")
If a Is Nothing Then MsgBox "2:nothing" '表示しない
MsgBox a.Row '表示する
a.Delete shift:=xlUp
If a Is Nothing Then MsgBox "3:nothing" '表示しない
MsgBox a.Row 'エラーになる
End Sub
知りたいのはaをdeleteしたことをif文で検出したいのです。どうすればいいのでしょうか。
（setしたあとでdeleteしても既にそれはnothingではありません。set a=nothing をa.Delete shift:=xlUp のあとに挿入すれば、3:nothingは表示します。しかし、今したいのは、deleteしたことを検知することです。）(on error goto を使わずに処理したいです。)
