okamura – ページ 23 – テックメモ

2020-01-232020-05-06

業務支援ソフトを作成するときに考えること

今回は業務支援ソフトを作成するときに考えていることを書いてみたいと思います。前提として、作成するのは本業プログラマではない私１人で、日数は数日～数週間程度かける規模。直接の利用者は数人程度としています。

・何を解決したいのか明確にする。
できれば１～２つ、できるだけ少なくする。とりあえずソフトを作れば色々よくなると考えている人が多いので注意する。

・解決したい内容を大きく２つに分類しながら考える。
１．管理精度を上げること。２．楽になること、という２つに分類しながら考える。社内環境にもよるだろうけど、個人的にはこの２つの違いは結構大きくて、かなり進め方が違ってくる。

・管理精度を上げることについて。
例えば、現在の予測精度や集計誤差などの精度を向上したい。あるいは、今までにはない集計や指標を導入したいなど。管理精度を上げることは管理者のためという場合が多く、作業者(ソフト利用者)は興味ないことが多いので、話をするときに作業者の要望を一緒に聞いても(無駄とは言わないが)視点が違っていることが多い。

・楽になることについて。
作業者が望むことはだいたいこれ。作業の手間を減らするなど、あらゆる面倒くさいと思う部分を減らしていく。

・管理精度を上げること、楽になることについて、当然どちら一つだけではなく両方に効果がある場合も多い。例えば、複数で管理しているような情報を一元化するば、管理精度も上がるし楽にもなる。

・作業者は具体的な方法が分からないことも多いので、開発するときにこうすれば楽だろうと想像する。

・素早く試作を作ってフィードバックもらう。
素早く試作(特に重要なのがUI)を作ってフィードバックをもとに修正という流れで作っていく。ソフトを利用する人はUIが重要で見えない部分に興味はない。

・正しい業務手順に軌道修正していく。
正しい業務手順に軌道修正していくか、既存の社内フローを踏襲するか悩むときは結構あるが、将来的に効果がありそうなら、少しずつでも正しい業務手順に軌道修正していく。

＊＊＊

本末転倒な話ではあるけど、自分が作る程度(マクロレベル)の業務支援ソフトの場合、利用者側での業務改善の方がはるかに効果的なことが多い。誰も見ていない指標を計算するのに時間をかけていたり、手間のかかる承認フローだったり、簡単に改善できるポイントはたくさんある。

例えば、ある資料について作成に時間がかかっているから、システムで自動化という話はありがちだけど、そもそもその資料を作らないという話はまず出てこない。作らなくても業務上困らないのに、誰か１人でも欲しいなら止めれない。こういう状況はいたるところで見つけることができる。

結局、情報共有とか意思決定の高速化というとみんな喜ぶけど、価値のない情報をたくさん共有したり、思いつきと変わらない意思決定を高速にできるようにしても何も変わらない。

2020-01-212020-01-22

VBA 講座ワークシート関数を挿入

以前書いたエクセルVBA講座の続きです。

VBA 講座

今回は少し実用的なものとしてループでワークシート関数を挿入する方法をお伝えしたいと思います。

ワークシート関数だからといって挿入自体に特別な方法は必要ありません。そのまま文字として入力すれば大丈夫です。

Sheets("Sheet1").Cells(1, 1).Value = "=SUM(A2:A3)"

1	Sheets("Sheet1").Cells(1, 1).Value = "=SUM(A2:A3)"

これを実行すると、Sheet1というシートのA1セルにSUM関数が入ります。

ではもう少し便利にするためにForループのカウンター変数を利用してみます。

For r = 1 To 4
Sheets("Sheet1").Cells(r, 1).Value = "=SUM(B" & r & ":C" & r & ")"
Next

For r = 1 To 4

Sheets("Sheet1").Cells(r, 1).Value = "=SUM(B" & r & ":C" & r & ")"

細かく見ていきます。

先ずForループの中の処理は4回実行されます。そのときrというカウンタ変数は1,2,3,4というように変化していきます。

rの変化と指定しているセルの位置を考えてみると、
rが1のときCells(1,2)
rが2のときCells(2,2)
rが3のときCells(3,2)
rが4のときCells(4,2)
となります。Cellsの中身は行,列ですので、A1,A2,A3,A4セルを対象にして挿入していることが分かります。

“=SUM(B” & r & “:C” & r & “)”の部分について、文字としてそのまま利用したい部分はダブルクォーテーションで囲い、変数の中身を利用したい部分はダブルクォーテーションで囲わずそのまま記入します。それらを＆記号(左右に半角スペース必須)でつなぎます。

＊＊＊

この部分は分かりづらいのもう少し細かく解説すると、セルの中に書き込める値は２種類(実際はもっとありますが現時点では)あると考えてください。１つはダブルクォーテーションで囲った文字、もう１つは変数で、ダブルクォーテーションで囲った文字はそのまま書き込まれ、変数は中身が利用されます。

そしてその２種類は＆記号(左右に半角スペース必須)で、順番や数に制限なく自由につなぐことができます。

v1 = "hello"
v2 = "world"

MsgBox v1 & " " & v2

v1 = "hello"

v2 = "world"

MsgBox v1 & " " & v2

v1 = "hello"
v2 = " "
v3 = "world"

MsgBox v1 & v2 & v3

v1 = "hello"

v2 = " "

v3 = "world"

MsgBox v1 & v2 & v3

どちらも実行するとhello worldと表示されます。

＊＊＊

話を戻します。

具体的にrの変化を見ていくと、
rが1のとき、”=SUM(B1:C1)”
rが2のとき、”=SUM(B2:C2)”
rが3のとき、”=SUM(B3:C3)”
rが4のとき、”=SUM(B4:C4)”
となります。

結果として
rが1のとき、A1セルに”=SUM(B1:C1)”
rが2のとき、A2セルに”=SUM(B2:C2)”
rが3のとき、A3セルに”=SUM(B3:C3)”
rが4のとき、A4セルに”=SUM(B4:C4)”
が入るということになります。

Forループのカウンタ変数をループの中で利用することはよくあります。むしろループの中で固定の文字列を挿入することの方が少ないぐらいです。

さらにカウンタ変数を利用したワークシート関数を挿入する方法が使えるようになると、かなり複雑なことができるようになります。

2020-01-142020-05-10

VBA SQL実験用④(SQLite)

最近では専門家ではなくてもデータ分析ができたほうがいいという話をよく聞きます。そういう話の中で利用されているソフトはだいたい専用ソフトかエクセルといった感じでしょうか。

ただ数は少ないですがSQLを使おうというのもあるようです。実際SQLは非常に便利でエクセルより多少敷居は高いですが、少し使えればエクセルでは面倒な処理も簡単にできたりします。経験上、ワークシート関数、VBA、SQLを使い分ければほとんどの処理ができると思います。

ですが、いざSQLを使おうとするとどのソフトを使ったらいいのか迷うと思います。一般的にはAccess、SQL Server、MySQL(MariaDB)、SQLiteあたりがお勧めされていますが、もしPCにAccessが入っているならAccessが一番手軽に始められるのではないかと思います。今回はSQLiteを採用していますが、私も最初はAccessを使っていました。

中小企業で働いているとデータ分析やITの専門家がいない場合も多いので、自分たちで少しでもデータ分析ができると役に立つことが多いです。

Sub auto_open()

Application.CommandBars("cell").Reset

With Application.CommandBars("cell").Controls.Add
.OnAction = "CreateTable"
.Caption = "テーブル作成"
End With

With Application.CommandBars("cell").Controls.Add
.OnAction = "QuerySelect"
.Caption = "SQL実行"
End With

End Sub

Sub auto_close()

On Error Resume Next

For i = 1 To 2
  Application.CommandBars("cell").Controls("テーブル作成").Delete
  Application.CommandBars("cell").Controls("SQL実行").Delete
Next i

End Sub

Function GetCon()

GetCon = "DRIVER=SQLite3 ODBC Driver; DataBase=" & ThisWorkbook.Path & "\dat"

End Function

Function GetType(s)

'型はSQLite以外の互換性のため

Select Case s
  Case "s"
  tmp = "varchar(255)"
  Case "i"
  tmp = "bigint"
  Case "m"
  tmp = "money"
  Case "d"
  tmp = "datetime"
End Select

GetType = tmp

End Function

Sub CreateTable()

Set cn = CreateObject("adodb.connection")
cn.Open GetCon

tbl = InputBox("テーブル名")
If tbl = "" Then Exit Sub

'テーブル削除

On Error Resume Next
cn.Execute "drop table " & tbl

'テーブル作成

On Error GoTo 0

fld = ""

For c = Selection(1).Column To Selection(Selection.Count).Column

  tmp = GetType(Right(ActiveSheet.Cells(Selection(1).Row, c).Value, 1))
  fld = fld & ActiveSheet.Cells(Selection(1).Row, c).Value & " " & tmp & ","

Next c

fld = Left(fld, Len(fld) - 1)

q = "create table " & tbl & " (id integer primary key," & fld & ")"
cn.Execute q: Debug.Print q

'データ登録

fld = ""

For c = Selection(1).Column To Selection(Selection.Count).Column
  fld = fld & ActiveSheet.Cells(Selection(1).Row, c).Value & ","
Next c

fld = Left(fld, Len(fld) - 1)

For r = (Selection(1).Row) + 1 To Selection(Selection.Count).Row
  For cc = Selection(1).Column To Selection(Selection.Count).Column
    rec = rec & "'" & ActiveSheet.Cells(r, cc).Value & "'" & ","
  Next cc

  rec = Left(rec, Len(rec) - 1)
  
  q = "insert into " & tbl & " (" & fld & ") values (" & rec & ")"
  cn.Execute q: Debug.Print q

  rec = ""
Next r

If cn.State = 1 Then cn.Close
Set cn = Nothing

MsgBox "done"

End Sub

Sub ExecuteQuery(q)

Set cn = CreateObject("adodb.connection")
Set rn = CreateObject("adodb.recordset")

cn.Open GetCon
rn.Open q, cn

'フィールド作成

i = 0

For c = Selection(1).Column To (Selection(1).Column + rn.Fields.Count) - 1
  Cells(Selection(Selection.Count).Row + 1, c).Value = rn.Fields(i).Name
  i = i + 1
Next c

'データ読込

Cells(Selection(Selection.Count).Row + 2, Selection(1).Column).CopyFromRecordset rn

If rn.State = 1 Then rn.Close
Set rn = Nothing

If cn.State = 1 Then cn.Close
Set cn = Nothing

End Sub

Sub ExecuteNonQuery(q)

Set cn = CreateObject("adodb.connection")

cn.Open GetCon
cn.Execute q

If cn.State = 1 Then cn.Close
Set cn = Nothing

End Sub

Sub QuerySelect()

If Selection.Rows.Count = 1 Then
  q = ActiveCell.Value
Else
  For r = 1 To Selection.Rows.Count
    q = q & " " & Selection(r)
  Next r
End If

If Left(q, 1) = "s" Then
  ExecuteQuery (q)
Else
  ExecuteNonQuery (q)
End If

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

Sub auto_open()

Application.CommandBars("cell").Reset

With Application.CommandBars("cell").Controls.Add

.OnAction = "CreateTable"

.Caption = "テーブル作成"

End With

With Application.CommandBars("cell").Controls.Add

.OnAction = "QuerySelect"

.Caption = "SQL実行"

End With

End Sub

Sub auto_close()

On Error Resume Next

For i = 1 To 2

Application.CommandBars("cell").Controls("テーブル作成").Delete

Application.CommandBars("cell").Controls("SQL実行").Delete

Next i

End Sub

Function GetCon()

GetCon = "DRIVER=SQLite3 ODBC Driver; DataBase=" & ThisWorkbook.Path & "\dat"

End Function

Function GetType(s)

'型はSQLite以外の互換性のため

Select Case s

Case "s"

tmp = "varchar(255)"

Case "i"

tmp = "bigint"

Case "m"

tmp = "money"

Case "d"

tmp = "datetime"

End Select

GetType = tmp

End Function

Sub CreateTable()

Set cn = CreateObject("adodb.connection")

cn.Open GetCon

tbl = InputBox("テーブル名")

If tbl = "" Then Exit Sub

'テーブル削除

On Error Resume Next

cn.Execute "drop table " & tbl

'テーブル作成

On Error GoTo 0

fld = ""

For c = Selection(1).Column To Selection(Selection.Count).Column

tmp = GetType(Right(ActiveSheet.Cells(Selection(1).Row, c).Value, 1))

fld = fld & ActiveSheet.Cells(Selection(1).Row, c).Value & " " & tmp & ","

Next c

fld = Left(fld, Len(fld) - 1)

q = "create table " & tbl & " (id integer primary key," & fld & ")"

cn.Execute q: Debug.Print q

'データ登録

fld = ""

For c = Selection(1).Column To Selection(Selection.Count).Column

fld = fld & ActiveSheet.Cells(Selection(1).Row, c).Value & ","

Next c

fld = Left(fld, Len(fld) - 1)

For r = (Selection(1).Row) + 1 To Selection(Selection.Count).Row

For cc = Selection(1).Column To Selection(Selection.Count).Column

rec = rec & "'" & ActiveSheet.Cells(r, cc).Value & "'" & ","

Next cc

rec = Left(rec, Len(rec) - 1)

q = "insert into " & tbl & " (" & fld & ") values (" & rec & ")"

cn.Execute q: Debug.Print q

rec = ""

Next r

If cn.State = 1 Then cn.Close

Set cn = Nothing

MsgBox "done"

End Sub

Sub ExecuteQuery(q)

Set cn = CreateObject("adodb.connection")

Set rn = CreateObject("adodb.recordset")

cn.Open GetCon

rn.Open q, cn

'フィールド作成

i = 0

For c = Selection(1).Column To (Selection(1).Column + rn.Fields.Count) - 1

Cells(Selection(Selection.Count).Row + 1, c).Value = rn.Fields(i).Name

i = i + 1

Next c

'データ読込

Cells(Selection(Selection.Count).Row + 2, Selection(1).Column).CopyFromRecordset rn

If rn.State = 1 Then rn.Close

Set rn = Nothing

If cn.State = 1 Then cn.Close

Set cn = Nothing

End Sub

Sub ExecuteNonQuery(q)

Set cn = CreateObject("adodb.connection")

cn.Open GetCon

cn.Execute q

If cn.State = 1 Then cn.Close

Set cn = Nothing

End Sub

Sub QuerySelect()

If Selection.Rows.Count = 1 Then

q = ActiveCell.Value

Else

For r = 1 To Selection.Rows.Count

q = q & " " & Selection(r)

Next r

End If

If Left(q, 1) = "s" Then

ExecuteQuery (q)

Else

ExecuteNonQuery (q)

End If

End Sub

追記

ちょっと原因は分からないけど、SQLite標準のカラムのデータ型(textやinteger)でテーブルを作成するとCopyFromRecordsetで取得できなくなる。

varchar(255)をカラムのデータ型に指定しているとCopyFromRecordsetで問題なく取得できる。

CopyFromRecordsetはテーブル作成時の型の影響を受けているらしい。とりあえずCopyFromRecordsetを使わないパターン

Sub auto_open()

Application.CommandBars("cell").Reset

With Application.CommandBars("cell").Controls.Add
.OnAction = "CreateTable"
.Caption = "テーブル作成"
End With

With Application.CommandBars("cell").Controls.Add
.OnAction = "QuerySelect"
.Caption = "SQL実行"
End With

End Sub

Sub auto_close()

On Error Resume Next

For i = 1 To 2
  Application.CommandBars("cell").Controls("テーブル作成").Delete
  Application.CommandBars("cell").Controls("SQL実行").Delete
Next i

End Sub

Function GetCon()

'GetCon = "DRIVER=SQLite3 ODBC Driver; DataBase=" & ThisWorkbook.Path & "\dat"
GetCon = "DRIVER=SQLite3 ODBC Driver; DataBase=" & Sheets("設定").Cells(1, 2).Value

End Function

Function GetType(s)

Select Case s
  Case "s"
  tmp = "text"
  Case "i"
  tmp = "integer"
End Select

GetType = tmp

End Function

Sub CreateTable()

Set cn = CreateObject("adodb.connection")
cn.Open GetCon

tbl = InputBox("テーブル名")
If tbl = "" Then Exit Sub

'テーブル削除

On Error Resume Next
cn.Execute "drop table " & tbl

'テーブル作成

On Error GoTo 0

Set topLeft = Selection(1)
Set bottomRight = Selection(Selection.Count)

head = ""
For c = topLeft.Column To bottomRight.Column
  tmp = GetType(Right(ActiveSheet.Cells(topLeft.Row, c).Value, 1))
  head = head & ActiveSheet.Cells(topLeft.Row, c).Value & " " & tmp & ","
Next c

head = Left(head, Len(head) - 1)

q = "create table " & tbl & " (id integer primary key," & head & ")"
cn.Execute q

'データ登録

head = ""
For c = topLeft.Column To bottomRight.Column
  head = head & ActiveSheet.Cells(topLeft.Row, c).Value & ","
Next c

head = Left(head, Len(head) - 1)
For r = topLeft.Row + 1 To bottomRight.Row

  For c = topLeft.Column To bottomRight.Column
    body = body & "'" & ActiveSheet.Cells(r, c).Value & "'" & ","
  Next c

  body = Left(body, Len(body) - 1)
  
  q = "insert into " & tbl & " (" & head & ") values (" & body & ")"
  cn.Execute q

  body = ""
  
Next r

If cn.State = 1 Then cn.Close
Set cn = Nothing

MsgBox "done"

End Sub

Sub ExecuteQuery(q)

Set cn = CreateObject("adodb.connection")
Set rn = CreateObject("adodb.recordset")

cn.Open GetCon
rn.Open q, cn

Set topLeft = Selection(1)
Set bottomRight = Selection(Selection.Count)

'見出

i = 0
For c = topLeft.Column To (topLeft.Column + rn.Fields.Count) - 1
  ActiveSheet.Cells(bottomRight.Row + 1, c).Value = rn.Fields(i).Name
  i = i + 1
Next c

'本体

r = 2
Do Until rn.EOF

  i = 0
  For c = topLeft.Column To (topLeft.Column + rn.Fields.Count) - 1
    ActiveSheet.Cells(bottomRight.Row + r, c).Value = rn.Fields(i)
    i = i + 1
  Next c
  
  rn.MoveNext
  r = r + 1
Loop

If rn.State = 1 Then rn.Close
Set rn = Nothing

If cn.State = 1 Then cn.Close
Set cn = Nothing

End Sub

Sub ExecuteNonQuery(q)

Set cn = CreateObject("adodb.connection")

cn.Open GetCon
cn.Execute q

If cn.State = 1 Then cn.Close
Set cn = Nothing

End Sub

Sub QuerySelect()

If Selection.Rows.Count = 1 Then
  q = ActiveCell.Value
Else
  For r = 1 To Selection.Rows.Count
    q = q & " " & Selection(r)
  Next r
End If

If Left(q, 1) = "s" Then
  ExecuteQuery (q)
Else
  ExecuteNonQuery (q)
End If

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

Sub auto_open()

Application.CommandBars("cell").Reset

With Application.CommandBars("cell").Controls.Add

.OnAction = "CreateTable"

.Caption = "テーブル作成"

End With

With Application.CommandBars("cell").Controls.Add

.OnAction = "QuerySelect"

.Caption = "SQL実行"

End With

End Sub

Sub auto_close()

On Error Resume Next

For i = 1 To 2

Application.CommandBars("cell").Controls("テーブル作成").Delete

Application.CommandBars("cell").Controls("SQL実行").Delete

Next i

End Sub

Function GetCon()

'GetCon = "DRIVER=SQLite3 ODBC Driver; DataBase=" & ThisWorkbook.Path & "\dat"

GetCon = "DRIVER=SQLite3 ODBC Driver; DataBase=" & Sheets("設定").Cells(1, 2).Value

End Function

Function GetType(s)

Select Case s

Case "s"

tmp = "text"

Case "i"

tmp = "integer"

End Select

GetType = tmp

End Function

Sub CreateTable()

Set cn = CreateObject("adodb.connection")

cn.Open GetCon

tbl = InputBox("テーブル名")

If tbl = "" Then Exit Sub

'テーブル削除

On Error Resume Next

cn.Execute "drop table " & tbl

'テーブル作成

On Error GoTo 0

Set topLeft = Selection(1)

Set bottomRight = Selection(Selection.Count)

head = ""

For c = topLeft.Column To bottomRight.Column

tmp = GetType(Right(ActiveSheet.Cells(topLeft.Row, c).Value, 1))

head = head & ActiveSheet.Cells(topLeft.Row, c).Value & " " & tmp & ","

Next c

head = Left(head, Len(head) - 1)

q = "create table " & tbl & " (id integer primary key," & head & ")"

cn.Execute q

'データ登録

head = ""

For c = topLeft.Column To bottomRight.Column

head = head & ActiveSheet.Cells(topLeft.Row, c).Value & ","

Next c

head = Left(head, Len(head) - 1)

For r = topLeft.Row + 1 To bottomRight.Row

For c = topLeft.Column To bottomRight.Column

body = body & "'" & ActiveSheet.Cells(r, c).Value & "'" & ","

Next c

body = Left(body, Len(body) - 1)

q = "insert into " & tbl & " (" & head & ") values (" & body & ")"

cn.Execute q

body = ""

Next r

If cn.State = 1 Then cn.Close

Set cn = Nothing

MsgBox "done"

End Sub

Sub ExecuteQuery(q)

Set cn = CreateObject("adodb.connection")

Set rn = CreateObject("adodb.recordset")

cn.Open GetCon

rn.Open q, cn

Set topLeft = Selection(1)

Set bottomRight = Selection(Selection.Count)

'見出

i = 0

For c = topLeft.Column To (topLeft.Column + rn.Fields.Count) - 1

ActiveSheet.Cells(bottomRight.Row + 1, c).Value = rn.Fields(i).Name

i = i + 1

Next c

'本体

r = 2

Do Until rn.EOF

i = 0

For c = topLeft.Column To (topLeft.Column + rn.Fields.Count) - 1

ActiveSheet.Cells(bottomRight.Row + r, c).Value = rn.Fields(i)

i = i + 1

Next c

rn.MoveNext

r = r + 1

Loop

If rn.State = 1 Then rn.Close

Set rn = Nothing

If cn.State = 1 Then cn.Close

Set cn = Nothing

End Sub

Sub ExecuteNonQuery(q)

Set cn = CreateObject("adodb.connection")

cn.Open GetCon

cn.Execute q

If cn.State = 1 Then cn.Close

Set cn = Nothing

End Sub

Sub QuerySelect()

If Selection.Rows.Count = 1 Then

q = ActiveCell.Value

Else

For r = 1 To Selection.Rows.Count

q = q & " " & Selection(r)

Next r

End If

If Left(q, 1) = "s" Then

ExecuteQuery (q)

Else

ExecuteNonQuery (q)

End If

End Sub

2020-01-132020-05-06

Excel 仕入集計(簡易原価計算)

原価計算といえば製造業では特に重視されていてよく耳にするかと思います。一応、会計的に正しい計算法というのもあるのですが、中小企業ではカスタマイズしたルールを用いてエクセルでざっくり計算していることが多いように思います。

今回は、本格的な原価計算とまではいかないけど、仕入をエクセルで集計するためには、どのように入力していけばいいのか少し考えてみたいと思います。

・集計単位で番号を付加する

製造番号やシリアル番号など名称に違いはあっても、恐らくどの会社でも管理用の番号を付加していると思います。受注単位、製造単位、単品ごとなど付加する単位は会社によって違うと思いますが、重要なのは原価を求めたい単位で番号を付加することです。例えば、受注はA製品×2台で受注番号を付加しているが、原価集計したいのはA製品それぞれ1台という場合、受注番号とは別に番号が必要になるということです。

一般的にはこういう場合、枝番で単品ごとの単位にしていることが多いと思います。そこでよくあるのが枝番を無視する工程の存在です。無視している工程では原価集計ができなくなるので注意が必要です。

ここではA製品×2台に対して001というNoを割り振ったとします。

・原価発生時エクセルに入力

まず原価として集計したいものは全てエクセルに入力することとします。会社によっては販管費相当でも個別の原価に入れたりしていると思います。例えば、運送費を個別の原価に入れて集計したい場合、運送費も入力するということです。

・仕入入力について

買掛単位ではなく原価単位の行数で入力します。

例えば、A製品(No001)とB製品に使う材料を購入したら1行の明細で100円となった場合。2行に分けてA用に50円、B用に50円というように入力します。会計では買掛単位として扱うことが多いと思うので、必要であればそれぞれ別管理が必要になるかもしれません。

仕入が1行でも、計算するタイミングで何かしらの基準でA製品とB製品に対して按分して計算するばいいのでは？と思われるかもしれません。もちろん専用ソフトでしっかり管理されていれば可能ですが、そうでないなら、最初から明細を原価単位で入力しておくほうが楽だと思います。

・エクセルの作り方

今回は入力、単価マスタ、集計結果を作っています。実際はそれぞれ別シートにして項目も多くなるかと思います。

ポイントとなる関数はSUMIFS、VLOOKUP、INDIRECTです。関数自体は他のサイトに分かりやすい解説があるのでそちらを見ていただくとして、どのように使っているのかというと、入力から単価マスタの参照はVLOOKUPを使い、集計結果から入力の参照はSUMIFSを使い、それぞれ最終行をINDIRECTで指定しています。

この中でも一番重要なのがSUMIFSです。単価マスタはなくても大丈夫なので、もっと簡単にしたい場合は入力と集計結果だけ作って、SUMIFSで集計しても大丈夫かと思います。

2020-01-042020-01-13

VBA 講座

エクセルにはVBAという開発環境が付属しており、VBAを活用するとエクセル上の作業を自動化したりすることができます。

大手企業では業務ごとに専用ソフトを導入していたり、開発の専門部署があったりしますので、一般の従業員がVBAを使う機会は少ないかもしれませんが、中小企業ではVBAを使うと業務を効率化することができます。

私もそれほど詳しくありませんが、実際に今までいくつかVBAを業務に役立ててきましたので、ここではその経験を分かりやすくお伝えしていきたいと思います。

VBAを始めるにあたって何が大変なのかというと、面白くもない基礎知識を覚えなければいけないということがあります。VBAはプログラミング言語の一種なので、プログラミング未経験の人からすると、最初に覚えなければいけない内容もかなりの量になってしまいます。

やりたいことは明確なのに、すぐにそこに行けないのはもどかしいものです。ですので、ここではなるべく早く使えるようになることを目標にして、細かい部分は省き、必要なことは作りながら覚えればいいという考えで進めたいと思います。

また、VBAなどプログラミングではやりたいことに対して複数の方法が存在するのですが、これもあえて一つの方法を採用してしまおうかと思います。

VBAの実行方法

開発タブ＞挿入＞ActiveXコントロール＞コマンドボタン
追加されたコマンドボタンをダブルクリックします。

VBA用のエディタが表示されたと思います。

表示された
Private Sub CommandButton1_Click()
と
End Sub
の間に処理を記入していくことになります。

もし開発タブが表示されていない場合は、
ファイル＞オプション＞リボンのユーザー設定
開発にチェックを付けます。

ではどうやってVBAを実行するのか？ですが、開発タブの中にデザインモードというボタンがあり、これが押されている状態では今のようにVBAのエディタが開きます。

デザインモードのボタンをもう一度押すと、デザインモードが押されていない状態になり、その状態でコマンドボタンを押すとVBAが実行されます。

開発中にわざわざボタンを押さずに、素早く実行したい場合は、
Private Sub CommandButton1_Click()
と
End Sub
の間にカーソルがある状態で、VBA用エディタの再生ボタンを押すことで実行できます。

セルに値を入れる

Sheets(“Sheet1”).Cells(1, 1).Value = “1”

セルに値を入れるときはこのように書きます。どのシートなのか、どのセルなのかを指定し、そのセルの中身をValueで指定します。

ちなみ、セルを指定しているのだからわざわざValueは必要ないのでは？と思うかもしれません。(実際なくても動くのですが)なぜValueが必要なのかというと、セルの塗りつぶしなどセルの中身とは関係ない部分を指定することもあるので、中身はValueで操作できるよと覚えておいてください。

細かくみていくと、
Sheets(“シート名”)
でシート名を指定し、
Cells(行, 列)
で何行目の何列目にあるセルなのかを指定し、
Value
で指定したセルの値を操作できるという意味です。

ここでのイコールは代入(入れる)という意味です。つまりSheet1の1行目で1列目のセルに”1″を入れるという意味です。

数値と文字

VBAでは数値だったらそのまま直接(1など)書くことができます。文字だったらダブルクォーテーションで囲う(“1″など)必要があります。でも今回1をダブルクォーテーションで囲ってなかった？と思うかもしれません。

少し難しい話ですが、1と”1″は一般的なプログラミングでは数値の1と文字の1として区別されます。いくつか違いはありますが、数値の1は四則演算できて、文字の1は四則演算できないというような違いがあります。つまり上記では数値ではなく文字の1を代入したということです。

VBAの特徴として、文字の数値(“1″など)でも、どうやら数値として使ってるっぽいなとVBAが判断すると自動で数値として扱ってくれます。

このあたりを正確に理解しようとすると型というものが出てきてしまうので、今は数値と文字の違いはあるけど、VBAはいい具合に判断してくれる程度に理解しておけば大丈夫です。

値のコピー

セルの書式や文字色などもコピーできるのですが、最初は値だけコピーする方法を覚えておけば大丈夫です。Valueを使ってイコールで代入するだけです。

Sheets("Sheet1").Cells(1, 1).Value = Sheets("Sheet1").Cells(2, 2).Value

1	Sheets("Sheet1").Cells(1, 1).Value = Sheets("Sheet1").Cells(2, 2).Value

値の表示(MsgBox)

次はセルの値を表示してみます。

MsgBox Sheets(“Sheet1”).Cells(1, 1).Value

代入ではないのでイコールはありません。代わりにMsgBoxと書かれています。これで指定した値をダイアログで表示することができます。Sheet1の1行目1列目のセルの値が表示されます。

ちなみに
MsgBox “A”
などのように表示する値を直接指定することも可能です。

MsgBoxはデバッグとしても利用されます。例えばプログラムを作っている最中に変数の中身を確認したい場合など頻繁にMsgBoxは利用されます。

v = "1"
MsgBox v
v = "2"
MsgBox v

v = "1"

MsgBox v

v = "2"

MsgBox v

ループ(For文)

セルの値を１つずつ設定したり取得したりするだけでは手作業と大きな違いはありません。VBAのメリットは多くの処理を自動化できることですが、ループは自動化の基本の一つです。

For i = 1 To 10
Sheets("Sheet1").Cells(i, 1).Value = i
Next

For i = 1 To 10

Sheets("Sheet1").Cells(i, 1).Value = i

これを実行するとA列の1～10行目に1～10の値が入ります。

For 変数 = 開始値 to 終了値
　処理
Next

というのが基本です。

現時点では変数というのは入れ物と理解しておけば大丈夫です。名前も自由につけることができ、ここではiとしていますが、counterなどとしても大丈夫です。

変数iには1から10まで順番に代入され、そのたびに処理が実行されるということです。具体的にいうと
変数iが1のとき、
Sheets(“Sheet1”).Cells(1, 1).Value = 1
として処理されます。
変数iが2のとき、
Sheets(“Sheet1”).Cells(2, 1).Value = 2
として処理されます。
このように、iが10になるまで繰り返されていきます。

また、変数は1からの必要はありませんし、処理の中で使わなくても問題ありません。

For i = 2 To 3
MsgBox "A"
Next

For i = 2 To 3

MsgBox "A"

これだとAが2回表示されるだけです。処理でiは使っていません。ループを2回するだけです。

条件

次に説明するDo-WhileとIfで条件というのがでてきます。条件とは2つの変数あるいは直接の値を指定し、その2つの間に下記の式を書いてそれが満たされた場合、True(処理の実行)となり、満たされない場合、False(処理が実行されない)となります。

条件は
A = B (AとBが同じ)
A <> B (AとBが違う)
A >= B (AがB以上)
A <= B (AがB以下)
A > B (AがBより大きい)
A < B (AがBより小さい)
のような種類があります。

実際AとBには変数か値が入ります。
変数　条件　変数
変数　条件　　値
　値　条件　変数
　値　条件　　値
いずれの組み合わせてでも大丈夫です。

条件はOrとAndを使うことで複数同時に使うこともできます。意味はそのまま、Orであればどちらかの条件を満たす、Andであれば両方の条件を満たすという意味になります。

例えば
c = 5 Or r = 5
であれば、cという変数の中に5が入っている状態か、rという変数の中に5が入っている状態のどちらか一方でTrueとなります。

c = 5 And r = 5
であれば、cという変数の中に5が入っている状態であり、rという変数の中にも5が入っている状態ではじめてTrueとなります。

ループ(Do-While文)

Do While 条件
　処理
Loop
が基本です。

条件が満たされている間処理をします。

i = 1
Do While i <= 3
  MsgBox i
  i = i + 1
Loop

i = 1

Do While i <= 3

MsgBox i

i = i + 1

Loop

これで1から3まで表示されます。

同じループでForと何が違うの？と思うかもしれません。実際、同じことをしようと思えばどちらを使ってもできます。

使い分けとして、データ量が固定の範囲をループさせる場合はForを使い、データがどんどん追加されていくようなタイプの範囲をループさせる場合はDo-Whileを使うという感じです。

条件分岐(If文)

ある条件が満たされる場合のみ処理を実行することができます。

If 条件 Then
　処理
End If
が基本となります。

Sub test()

If 5 >= 5 Then
  MsgBox "Hello" '表示される
End If

If 5 > 5 Then
  MsgBox "World" ' 表示されない
End If

If "5" >= 5 Then
  MsgBox "!!!" ' 表示される
End If

End Sub

Sub test()

If 5 >= 5 Then

MsgBox "Hello" '表示される

End If

If 5 > 5 Then

MsgBox "World" ' 表示されない

End If

If "5" >= 5 Then

MsgBox "!!!" ' 表示される

End If

End Sub

このように書くことができます。

既に少し説明しましたが、VBAでは文字と数値をうまい具合に扱ってくれます。一般的なプログラミングでは数値と文字は比較できないので、例えば”5″と5は比較できません。この辺りの特徴は少し意識しておいたほうがいいかもしれません。

If文ではだいたい同時ElseIfやElseも説明されていることが多いですが、とりあえず今の段階では使わなくても大丈夫です。

実用例

ここまでの説明で少し実用的なものを作ってみます。Sheet1のデータに条件を1つ通してSheet2にコピーしてみます。

Sheet1には2列データが入っていて、1列目には名称、2列目には数量を入れてあります。1列目が空白になるまでループし、2列目が0の場合はコピーしないという処理をおこないます。

targetRow = 1 '書き込み対象行

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

  n = Sheets("Sheet1").Cells(r, 1).Value
  q = Sheets("Sheet1").Cells(r, 2).Value
  
  If q <> "0" Then
    
    Sheets("Sheet2").Cells(targetRow, 1).Value = n
    Sheets("Sheet2").Cells(targetRow, 2).Value = q
    rr = rr + 1
    
  End If
  
  r = r + 1
Loop

targetRow = 1 '書き込み対象行

r = 2

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

n = Sheets("Sheet1").Cells(r, 1).Value

q = Sheets("Sheet1").Cells(r, 2).Value

If q <> "0" Then

Sheets("Sheet2").Cells(targetRow, 1).Value = n

Sheets("Sheet2").Cells(targetRow, 2).Value = q

rr = rr + 1

End If

r = r + 1

Loop

非常に簡単な例ですが、手作業では困難な程度の量になってくると自動化が役に立つと思います。

2019-12-172021-07-29

VBA 重複削除

重複を取り除く方法はいくつかあると思うけど、ネット上で一番有名なdictionaryを使う方法を採用。

Sub DeleteDuplicate()

Set dic = CreateObject("scripting.dictionary")

For Each r In Selection
  If Not dic.exists(r.Value) Then dic.Add r.Value, ""
Next

k = dic.keys
For i = 0 To dic.Count - 1
  Sheets("Sheet2").Cells(i + 1, 1).Value = k(i)
Next i

End Sub

Sub DeleteDuplicate()

Set dic = CreateObject("scripting.dictionary")

For Each r In Selection

If Not dic.exists(r.Value) Then dic.Add r.Value, ""

k = dic.keys

For i = 0 To dic.Count - 1

Sheets("Sheet2").Cells(i + 1, 1).Value = k(i)

Next i

End Sub

少し違うバージョン

Sub DeleteDuplicate()
 
Set dic = CreateObject("scripting.dictionary")

Set w = ActiveSheet

For r = 2 To 4111

  k = w.Cells(r, 1).Value
  v = w.Cells(r, 2).Value

  If Not dic.exists(k) Then dic.Add k, v
  
Next

kk = dic.keys
vv = dic.items

For i = 0 To dic.Count - 1
  w.Cells(i + 1, 4).Value = kk(i)
  w.Cells(i + 1, 5).Value = vv(i)
Next i
 
End Sub

Sub DeleteDuplicate()

Set dic = CreateObject("scripting.dictionary")

Set w = ActiveSheet

For r = 2 To 4111

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

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

If Not dic.exists(k) Then dic.Add k, v

kk = dic.keys

vv = dic.items

For i = 0 To dic.Count - 1

w.Cells(i + 1, 4).Value = kk(i)

w.Cells(i + 1, 5).Value = vv(i)

Next i

End Sub

2019-12-112020-01-15

VBA 関数の参照先アドレス(行)の増減

大量の関数を複写や移動するとき、参照先アドレスの数値(行)だけ一括で増減したいときがある。

例えばデータ用のシートに対して印刷用のシートからの参照していて、行数の関係が対応していないためそのまま複写できない場合など。

今回は式の中にアドレスが1つだけの場合を想定している。

Sub AddSub()
 
sumValue = InputBox("行加算")
 
For Each cell In Selection
 
 targetRowValue = cell.Value ' sheet!A80
 
 If targetRowValue = "" Or Left(targetRowValue, 1) <> "#" Then GoTo brk
 
 tmp = InStr(targetRowValue, "!")
 targetAddress = Mid(targetRowValue, tmp + 1) ' A2
 targetSheetName = Left(targetRowValue, tmp) ' sheet!
 
 tmp = StrReverse(targetAddress & "9")
 tmp = Val(tmp)
 tmp = StrReverse(tmp)
 targetAddressNum = Left(tmp, Len(tmp) - 1) ' 2
 
 targetAddressAsc = Replace(targetAddress, targetAddressNum, "") ' A
  
 cell.Value = targetSheetName & targetAddressAsc & (0 + targetAddressNum + sumValue)
  
brk:
 
Next
 
End Sub

Sub AddSub()

sumValue = InputBox("行加算")

For Each cell In Selection

targetRowValue = cell.Value ' sheet!A80

If targetRowValue = "" Or Left(targetRowValue, 1) <> "#" Then GoTo brk

tmp = InStr(targetRowValue, "!")

targetAddress = Mid(targetRowValue, tmp + 1) ' A2

targetSheetName = Left(targetRowValue, tmp) ' sheet!

tmp = StrReverse(targetAddress & "9")

tmp = Val(tmp)

tmp = StrReverse(tmp)

targetAddressNum = Left(tmp, Len(tmp) - 1) ' 2

targetAddressAsc = Replace(targetAddress, targetAddressNum, "") ' A

cell.Value = targetSheetName & targetAddressAsc & (0 + targetAddressNum + sumValue)

brk:

End Sub

2019-11-202020-01-16

VBA フォルダ作成

以前フォルダの構成をエクセルに書き出す機能を作ってみた。

VBA フォルダ・ファイルのリンクの一覧

逆にエクセルからフォルダを作成できると便利という場面も多いので作ってみた。

Sub CreateFolder()

Set w = Sheets("表紙")

basePath = Application.ActiveWorkbook.Path

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

  targetPath = basePath & "\" & w.Cells(r, 1).Value
  
  If "" <> Dir(targetPath, vbDirectory) Then
    MsgBox w.Cells(r, 1).Value & "は既に存在します。"
    Exit Sub
  End If

r = r + 1
Loop

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

  targetPath = basePath & "\" & w.Cells(r, 1).Value
  If "" = Dir(targetPath, vbDirectory) Then MkDir (targetPath) ' 指定が重複してた場合
  
r = r + 1
Loop

MsgBox "完了しました。"

End Sub

Sub CreateFolder()

Set w = Sheets("表紙")

basePath = Application.ActiveWorkbook.Path

r = 1

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

targetPath = basePath & "\" & w.Cells(r, 1).Value

If "" <> Dir(targetPath, vbDirectory) Then

MsgBox w.Cells(r, 1).Value & "は既に存在します。"

Exit Sub

End If

r = r + 1

Loop

r = 1

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

targetPath = basePath & "\" & w.Cells(r, 1).Value

If "" = Dir(targetPath, vbDirectory) Then MkDir (targetPath) ' 指定が重複してた場合

r = r + 1

Loop

MsgBox "完了しました。"

End Sub

2019-09-202020-02-03

C# Reflection

class Test
{
    public string UserName = "hello";
    public int UserAge = 0;
    public Test()
    {
        UserAge = 10;
    }
}

public Form1()
{
    InitializeComponent();

    // 通常アクセス
    Debug.Print(new Test().UserName); // hello

    // リフレクション

    var testObj = new Test(); // インスタンス生成
    var objType = testObj.GetType(); // Type取得

    Debug.Print(objType.Name); // Test

    var fieldInfo = objType.GetField("UserAge"); // TypeからFieldInfo取得 (存在しないとnull)

    Debug.Print(fieldInfo.GetValue(testObj).ToString()); // 10
    // GetValueはインスタンスを渡す点に注意

    fieldInfo.SetValue(testObj, 20);
    Debug.Print(testObj.UserAge.ToString()); // 20
}

class Test

{

public string UserName = "hello";

public int UserAge = 0;

public Test()

{

UserAge = 10;

}

public Form1()

{

InitializeComponent();

// 通常アクセス

Debug.Print(new Test().UserName); // hello

// リフレクション

var testObj = new Test(); // インスタンス生成

var objType = testObj.GetType(); // Type取得

Debug.Print(objType.Name); // Test

var fieldInfo = objType.GetField("UserAge"); // TypeからFieldInfo取得 (存在しないとnull)

Debug.Print(fieldInfo.GetValue(testObj).ToString()); // 10

// GetValueはインスタンスを渡す点に注意

fieldInfo.SetValue(testObj, 20);

Debug.Print(testObj.UserAge.ToString()); // 20

}

Getterにアクセスする場合もほぼ同じ。

foreach (var model in SalesDataGridViewModels)
{
  var objType = model.GetType();
  var propInfo = objType.GetProperty(ColumnSelect.Text);
  string targetString = propInfo.GetValue(model).ToString().Replace("　", " ");
}

foreach (var model in SalesDataGridViewModels)

{

var objType = model.GetType();

var propInfo = objType.GetProperty(ColumnSelect.Text);

string targetString = propInfo.GetValue(model).ToString().Replace("　", " ");

}

2019-09-172020-05-05

C# DirectX基本色々

using System;
using System.Drawing;
using System.Windows.Forms;

using Microsoft.DirectX;
using Microsoft.DirectX.Direct3D;

namespace WindowsFormsApp5
{
    public partial class Form1 : Form
    {
        private Device device = null;
        private Microsoft.DirectX.Direct3D.Font _font = null; // Direct3DX

        public Form1()
        {
            InitializeComponent();
            this.ClientSize = new Size(640, 480);

            // デバイス初期化
            SetupDevice(this);

            // マウスイベントで描画
            this.MouseMove += MainRender;

            // 処理ループの場合
            while (this.Created)
            {
                System.Threading.Thread.Sleep(1);
                Application.DoEvents();
            }
        }
        private void MainRender(object sender, EventArgs e)
        {
            device.Clear(
                ClearFlags.Target, // クリアするターゲット
                Color.Blue,
                1.0f,
                0);

            device.BeginScene();

            // 図形描画1
            DrawVertex(CreateVertex());

            // 図形描画2
            DrawMesh();

            // 文字列描画
            DrawText();

            device.EndScene();
            device.Present();
        }

        private void DrawMesh()
        {
            Material material = new Material();
            material.Ambient = Color.Red;
            material.Diffuse = Color.AliceBlue;

            device.Material = material;

            // レンダリングオプション
            device.RenderState.ZBufferEnable = true;

            // カメラ
            device.Transform.View = Matrix.LookAtLH(
                new Vector3(5,5,-10), // カメラの位置
                new Vector3(0,0,0), // カメラの向いている方向
                new Vector3(0,1,0)); // 空間の上を示す方向

            // 投影変換
            device.Transform.Projection = Matrix.PerspectiveFovLH(
                (float)Math.PI/4, // 視界の広さ
                1.0F,
                1.0F,
                100.0F);

            // 照明
            device.Lights[0].Type = LightType.Directional;
            device.Lights[0].Direction = new Vector3(1, -1, 1);
            device.Lights[0].Diffuse = Color.FromArgb(255, 255, 255);
            device.Lights[0].Enabled = true;

            var mesh = Mesh.Box(device, 5, 5, 5);
            mesh.DrawSubset(0);
        }

        private void DrawText()
        {
            FontDescription fd = new FontDescription();
            fd.Height = 24;
            fd.FaceName = "ＭＳ ゴシック";

            _font = new Microsoft.DirectX.Direct3D.Font(device, fd);
            _font.DrawText(
                null, // Spriteクラスの使用有無
                "テスト", 
                PointToClient(MousePosition).X,
                PointToClient(MousePosition).Y,
                Color.White);
        }

        public CustomVertex.TransformedColoredTextured[] CreateVertex()
        {
            int mouseX = PointToClient(MousePosition).X;
            int mouseY = PointToClient(MousePosition).Y;
            int width = 200;
            int height = 100;

            // TransformedColoredTextured
            // 頂点データ作成
            // 頂点の型 (2Dの座標、色、テクスチャの座標を保持)

            var verts = new CustomVertex.TransformedColoredTextured[4];

            // 左上
            verts[0].X = mouseX;
            verts[0].Y = mouseY;
            verts[0].Tu = 0.0f;
            verts[0].Tv = 1.0f;
            verts[0].Color = Color.Green.ToArgb();

            // 右上
            verts[1].X = mouseX + width;
            verts[1].Y = mouseY;
            verts[1].Tu = 0.0f;
            verts[1].Tv = 1.0f;

            // 左下
            verts[2].X = mouseX;
            verts[2].Y = mouseY + height;
            verts[2].Tu = 0.0f;
            verts[2].Tv = 1.0f;

            // 右下
            verts[3].X = mouseX + width;
            verts[3].Y = mouseY + height;
            verts[3].Tu = 0.0f;
            verts[3].Tv = 1.0f;

            return verts;
        }

        private void DrawVertex(CustomVertex.TransformedColoredTextured[] verts)
        {
            // 頂点配列を頂点バッファへ

            if (device == null) return;

            VertexBuffer vertexBuffer = new VertexBuffer(
                typeof(CustomVertex.TransformedColoredTextured),
                4,
                device,
                0,
                CustomVertex.TransformedColoredTextured.Format,
                Pool.Managed);

            GraphicsStream stm = vertexBuffer.Lock(0, 0, 0);
            stm.Write(verts);
            vertexBuffer.Unlock();
            device.SetStreamSource(0, vertexBuffer, 0);
            device.VertexFormat = CustomVertex.TransformedColoredTextured.Format;
            device.DrawPrimitives(PrimitiveType.TriangleStrip, 0, 2);
        }

        public void SetupDevice(Control target)
        {
            PresentParameters pp = new PresentParameters();
            pp.Windowed = true;
            pp.SwapEffect = SwapEffect.Discard;
            pp.PresentationInterval = PresentInterval.Immediate;

            // 通常ハードウェア処理の方が高性能だかグラフィックカードなどにより要変更

            device = new Device(
                0, // 物理デバイスインデックス(通常0)
                DeviceType.Hardware,　// ハードウェアアクセラレーション有効化
                target,
                CreateFlags.HardwareVertexProcessing, // ハードウェアによる頂点処理有効化
                pp);
        }
    }
}

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

using System;

using System.Drawing;

using System.Windows.Forms;

using Microsoft.DirectX;

using Microsoft.DirectX.Direct3D;

namespace WindowsFormsApp5

{

public partial class Form1 : Form

{

private Device device = null;

private Microsoft.DirectX.Direct3D.Font _font = null; // Direct3DX

public Form1()

{

InitializeComponent();

this.ClientSize = new Size(640, 480);

// デバイス初期化

SetupDevice(this);

// マウスイベントで描画

this.MouseMove += MainRender;

// 処理ループの場合

while (this.Created)

{

System.Threading.Thread.Sleep(1);

Application.DoEvents();

}

private void MainRender(object sender, EventArgs e)

{

device.Clear(

ClearFlags.Target, // クリアするターゲット

Color.Blue,

1.0f,

0);

device.BeginScene();

// 図形描画1

DrawVertex(CreateVertex());

// 図形描画2

DrawMesh();

// 文字列描画

DrawText();

device.EndScene();

device.Present();

}

private void DrawMesh()

{

Material material = new Material();

material.Ambient = Color.Red;

material.Diffuse = Color.AliceBlue;

device.Material = material;

// レンダリングオプション

device.RenderState.ZBufferEnable = true;

// カメラ

device.Transform.View = Matrix.LookAtLH(

new Vector3(5,5,-10), // カメラの位置

new Vector3(0,0,0), // カメラの向いている方向

new Vector3(0,1,0)); // 空間の上を示す方向

// 投影変換

device.Transform.Projection = Matrix.PerspectiveFovLH(

(float)Math.PI/4, // 視界の広さ

1.0F,

100.0F);

// 照明

device.Lights[0].Type = LightType.Directional;

device.Lights[0].Direction = new Vector3(1, -1, 1);

device.Lights[0].Diffuse = Color.FromArgb(255, 255, 255);

device.Lights[0].Enabled = true;

var mesh = Mesh.Box(device, 5, 5, 5);

mesh.DrawSubset(0);

}

private void DrawText()

{

FontDescription fd = new FontDescription();

fd.Height = 24;

fd.FaceName = "ＭＳゴシック";

_font = new Microsoft.DirectX.Direct3D.Font(device, fd);

_font.DrawText(

null, // Spriteクラスの使用有無

"テスト",

PointToClient(MousePosition).X,

PointToClient(MousePosition).Y,

Color.White);

}

public CustomVertex.TransformedColoredTextured[] CreateVertex()

{

int mouseX = PointToClient(MousePosition).X;

int mouseY = PointToClient(MousePosition).Y;

int width = 200;

int height = 100;

// TransformedColoredTextured

// 頂点データ作成

// 頂点の型 (2Dの座標、色、テクスチャの座標を保持)

var verts = new CustomVertex.TransformedColoredTextured[4];

// 左上

verts[0].X = mouseX;

verts[0].Y = mouseY;

verts[0].Tu = 0.0f;

verts[0].Tv = 1.0f;

verts[0].Color = Color.Green.ToArgb();

// 右上

verts[1].X = mouseX + width;

verts[1].Y = mouseY;

verts[1].Tu = 0.0f;

verts[1].Tv = 1.0f;

// 左下

verts[2].X = mouseX;

verts[2].Y = mouseY + height;

verts[2].Tu = 0.0f;

verts[2].Tv = 1.0f;

// 右下

verts[3].X = mouseX + width;

verts[3].Y = mouseY + height;

verts[3].Tu = 0.0f;

verts[3].Tv = 1.0f;

return verts;

}

private void DrawVertex(CustomVertex.TransformedColoredTextured[] verts)

{

// 頂点配列を頂点バッファへ

if (device == null) return;

VertexBuffer vertexBuffer = new VertexBuffer(

typeof(CustomVertex.TransformedColoredTextured),

device,

CustomVertex.TransformedColoredTextured.Format,

Pool.Managed);

GraphicsStream stm = vertexBuffer.Lock(0, 0, 0);

stm.Write(verts);

vertexBuffer.Unlock();

device.SetStreamSource(0, vertexBuffer, 0);

device.VertexFormat = CustomVertex.TransformedColoredTextured.Format;

device.DrawPrimitives(PrimitiveType.TriangleStrip, 0, 2);

}

public void SetupDevice(Control target)

{

PresentParameters pp = new PresentParameters();

pp.Windowed = true;

pp.SwapEffect = SwapEffect.Discard;

pp.PresentationInterval = PresentInterval.Immediate;

// 通常ハードウェア処理の方が高性能だかグラフィックカードなどにより要変更

device = new Device(

0, // 物理デバイスインデックス(通常0)

DeviceType.Hardware,　// ハードウェアアクセラレーション有効化

target,

CreateFlags.HardwareVertexProcessing, // ハードウェアによる頂点処理有効化

pp);

}