VBA ListBox参考 – テックメモ

ListBoxの使い方を忘れてしまうので、さっき作ったものをメモ代わり。

Private Sub CommandButton1_Click()

' 検索

TextBox1.Enabled = False
CommandButton1.Enabled = False

Set w = Sheets("dat")

r = 2
Do While w.Cells(r, 1).Value <> ""

  If TextBox1.Text = w.Cells(r, 1).Value Then

    TextBox2.Text = w.Cells(r, 3).Value
    TextBox3.Text = w.Cells(r, 10).Value
    TextBox4.Text = w.Cells(r, 11).Value
    TextBox5.Text = w.Cells(r, 17).Value
    Label7.caption = r
    CommandButton2.Enabled = True
    
    Call CheckDate
    Exit Sub
  
  End If

r = r + 1
Loop

TextBox1.Enabled = True
CommandButton1.Enabled = True

End Sub

Sub CheckDate()

On Error GoTo exception

s = CDate(TextBox3.Text)
e = CDate(TextBox4.Text)
e = DateAdd("d", 1, e)

' 今日が開始日より後で終了日より前

If s < Now And e > Now Then
  Label8.caption = "OK"
Else
  Label8.caption = "NG"
End If
    
Exit Sub

exception:

Label8.caption = "-"

End Sub

Private Sub CommandButton2_Click()

' 今日の日付を登録

Set w = Sheets("dat")

If TextBox5.Text <> "" Then
  result = TextBox5.Text & ", " & Month(Now) & "/" & Day(Now)
Else
  result = Month(Now) & "/" & Day(Now)
End If

If TextBox6.Text <> "" Then
  result = result & "(" & TextBox6.Text & ")"
End If

r = Label7.caption
w.Cells(r, 17).Value = result
TextBox5.Text = result

' CommandButton2.Enabled = False

w.Activate
w.Rows(r).Select

MsgBox "登録しました。"

End Sub

Private Sub CommandButton3_Click()

' キャンセル

TextBox1.Enabled = True
CommandButton1.Enabled = True

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
Label7.caption = ""
Label8.caption = ""

CommandButton2.Enabled = False
TextBox1.SetFocus
    
End Sub

Private Sub CommandButton5_Click()

' シート書き込み

If ListBox2.ListCount = 0 Then Exit Sub

yesNo = vbYes
If TextBox2.Text = "" Then yesNo = MsgBox("氏名がありません。登録しますか？", vbYesNo)
If yesNo = vbNo Then Exit Sub

Set w = Sheets("売上")

r = 1
Do While w.Cells(r, 4).Value <> "" ' 商品名で最終行を算出
  r = r + 1
Loop
targetRow = r

memberCode = TextBox1.Text
memberName = TextBox2.Text

For r = 0 To ListBox2.ListCount - 1

  productName = ListBox2.List(r, 0)
  unitPrice = ListBox2.List(r, 1)
  amount = ListBox2.List(r, 2)
  
  w.Cells(targetRow, 1).Value = DateTime.Now
  w.Cells(targetRow, 2).Value = memberCode
  w.Cells(targetRow, 3).Value = memberName
  w.Cells(targetRow, 4).Value = productName
  w.Cells(targetRow, 5).Value = unitPrice
  w.Cells(targetRow, 6).Value = amount
  
  targetRow = targetRow + 1
  
Next r

w.Activate
w.Rows(targetRow - 1).Select

MsgBox "登録しました。"

End Sub

Private Sub CommandButton6_Click()

' クリア

ComboBox1.Text = ""
ListBox2.Clear
Label12.caption = ""

End Sub

Private Sub UserForm_Initialize()

TextBox1.SetFocus
MasterSetup

End Sub

Sub MasterSetup()

' 商品リスト

ListBox1.ColumnCount = 2

Set w = Sheets("master")

r = 2
Do While w.Cells(r, 1).Value <> ""

  productName = w.Cells(r, 1).Value
  unitPrice = w.Cells(r, 2).Value
  ListBox1.AddItem ""
  ListBox1.List(ListBox1.ListCount - 1, 0) = productName
  ListBox1.List(ListBox1.ListCount - 1, 1) = unitPrice

r = r + 1
Loop

' 売上リスト

ListBox2.ColumnCount = 4


' 数量
For i = 1 To 10
  ComboBox1.AddItem i
Next

End Sub

Private Sub CommandButton4_Click()

' 転送

If ListBox1.Text = "" Then
  MsgBox "商品を選択してください。"
  Exit Sub
End If

If ComboBox1.Text = "" Then
  MsgBox "数量を選択してください。"
  Exit Sub
End If

productName = ListBox1.List(ListBox1.ListIndex, 0)
unitPrice = ListBox1.List(ListBox1.ListIndex, 1)
amount = ComboBox1.Text

ListBox2.AddItem ""
ListBox2.List(ListBox2.ListCount - 1, 0) = productName
ListBox2.List(ListBox2.ListCount - 1, 1) = unitPrice
ListBox2.List(ListBox2.ListCount - 1, 2) = amount
ListBox2.List(ListBox2.ListCount - 1, 3) = CDec(unitPrice) * CDec(amount)

TotalPrice

End Sub

Sub TotalPrice()

result = 0
For r = 0 To ListBox2.ListCount - 1
  result = CDec(result) + CDec(ListBox2.List(r, 3))
Next r

Label12.caption = "\ " & result

End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

Private Sub CommandButton1_Click()

' 検索

TextBox1.Enabled = False

CommandButton1.Enabled = False

Set w = Sheets("dat")

r = 2

Do While w.Cells(r, 1).Value <> ""

If TextBox1.Text = w.Cells(r, 1).Value Then

TextBox2.Text = w.Cells(r, 3).Value

TextBox3.Text = w.Cells(r, 10).Value

TextBox4.Text = w.Cells(r, 11).Value

TextBox5.Text = w.Cells(r, 17).Value

Label7.caption = r

CommandButton2.Enabled = True

Call CheckDate

Exit Sub

End If

r = r + 1

Loop

TextBox1.Enabled = True

CommandButton1.Enabled = True

End Sub

Sub CheckDate()

On Error GoTo exception

s = CDate(TextBox3.Text)

e = CDate(TextBox4.Text)

e = DateAdd("d", 1, e)

' 今日が開始日より後で終了日より前

If s < Now And e > Now Then

Label8.caption = "OK"

Else

Label8.caption = "NG"

End If

Exit Sub

exception:

Label8.caption = "-"

End Sub

Private Sub CommandButton2_Click()

' 今日の日付を登録

Set w = Sheets("dat")

If TextBox5.Text <> "" Then

result = TextBox5.Text & ", " & Month(Now) & "/" & Day(Now)

Else

result = Month(Now) & "/" & Day(Now)

End If

If TextBox6.Text <> "" Then

result = result & "(" & TextBox6.Text & ")"

End If

r = Label7.caption

w.Cells(r, 17).Value = result

TextBox5.Text = result

' CommandButton2.Enabled = False

w.Activate

w.Rows(r).Select

MsgBox "登録しました。"

End Sub

Private Sub CommandButton3_Click()

' キャンセル

TextBox1.Enabled = True

CommandButton1.Enabled = True

TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox6.Text = ""

Label7.caption = ""

Label8.caption = ""

CommandButton2.Enabled = False

TextBox1.SetFocus

End Sub

Private Sub CommandButton5_Click()

' シート書き込み

If ListBox2.ListCount = 0 Then Exit Sub

yesNo = vbYes

If TextBox2.Text = "" Then yesNo = MsgBox("氏名がありません。登録しますか？", vbYesNo)

If yesNo = vbNo Then Exit Sub

Set w = Sheets("売上")

r = 1

Do While w.Cells(r, 4).Value <> "" ' 商品名で最終行を算出

r = r + 1

Loop

targetRow = r

memberCode = TextBox1.Text

memberName = TextBox2.Text

For r = 0 To ListBox2.ListCount - 1

productName = ListBox2.List(r, 0)

unitPrice = ListBox2.List(r, 1)

amount = ListBox2.List(r, 2)

w.Cells(targetRow, 1).Value = DateTime.Now

w.Cells(targetRow, 2).Value = memberCode

w.Cells(targetRow, 3).Value = memberName

w.Cells(targetRow, 4).Value = productName

w.Cells(targetRow, 5).Value = unitPrice

w.Cells(targetRow, 6).Value = amount

targetRow = targetRow + 1

Next r

w.Activate

w.Rows(targetRow - 1).Select

MsgBox "登録しました。"

End Sub

Private Sub CommandButton6_Click()

' クリア

ComboBox1.Text = ""

ListBox2.Clear

Label12.caption = ""

End Sub

Private Sub UserForm_Initialize()

TextBox1.SetFocus

MasterSetup

End Sub

Sub MasterSetup()

' 商品リスト

ListBox1.ColumnCount = 2

Set w = Sheets("master")

r = 2

Do While w.Cells(r, 1).Value <> ""

productName = w.Cells(r, 1).Value

unitPrice = w.Cells(r, 2).Value

ListBox1.AddItem ""

ListBox1.List(ListBox1.ListCount - 1, 0) = productName

ListBox1.List(ListBox1.ListCount - 1, 1) = unitPrice

r = r + 1

Loop

' 売上リスト

ListBox2.ColumnCount = 4

' 数量

For i = 1 To 10

ComboBox1.AddItem i

End Sub

Private Sub CommandButton4_Click()

' 転送

If ListBox1.Text = "" Then

MsgBox "商品を選択してください。"

Exit Sub

End If

If ComboBox1.Text = "" Then

MsgBox "数量を選択してください。"

Exit Sub

End If

productName = ListBox1.List(ListBox1.ListIndex, 0)

unitPrice = ListBox1.List(ListBox1.ListIndex, 1)

amount = ComboBox1.Text

ListBox2.AddItem ""

ListBox2.List(ListBox2.ListCount - 1, 0) = productName

ListBox2.List(ListBox2.ListCount - 1, 1) = unitPrice

ListBox2.List(ListBox2.ListCount - 1, 2) = amount

ListBox2.List(ListBox2.ListCount - 1, 3) = CDec(unitPrice) * CDec(amount)

TotalPrice

End Sub

Sub TotalPrice()

result = 0

For r = 0 To ListBox2.ListCount - 1

result = CDec(result) + CDec(ListBox2.List(r, 3))

Next r

Label12.caption = "\ " & result

End Sub