アマガエルの掛け合いへしあい

ニホンアマガエルの合唱は、自分が鳴いた後、相手側が鳴くのを待ってからまた鳴くという阿吽の呼吸で行われる。隣り同士の鳴き声が被らないようにすることで、縄張りの白黒をはっきりさせる。

スピードスケートの空力

頭部と体の全面の空力特性が重要。

スーツの表面に突起を付けたり、縫い目を盛り上げたりすることで空気抵抗を減らす。表面の凹凸により気流が剥離しやすくなる。ゴルフボールのディンプル囲うと同じ原理。

矢についても同様な処理が施されることがあり、サンド処理、砂目仕上げで矢の表面に窪みを付ける。すると矢の直進性が増す。

企業シリーズ 1

独自動車大手メルセデスベンツ。
独立に王手、なるほど·ザ·ベンチ。

独電機大手シーメンス。
孤独に生きる伝説シーラカンス。

米国家安全保障局·NASでナス栽培の研究。

ミズノ開発課で水の開発か。

CreateBitmap関数

Function CreateBMP _
( _
ByRef ImageData() As RGB, _
ByVal BMPFileName As String _
) As Long

'## BMPファイル番号
Dim FileNumber As Long

'## BMPファイルに書き込む画像データ
Dim ImageBinaryData(10000000) As Byte

'## BMPファイルヘッダデータ
Dim FileType As Integer
Dim FileSize As Long
Dim ReservedA As Integer
Dim ReservedB As Integer
Dim ImageDataOffSet As Long
Dim HeaderSize As Long
Dim ImageWidth As Long
Dim ImageHeight As Long
Dim NumberOfPlanes As Integer
Dim RGBBit As Integer
Dim CompressionFormat As Long
Dim ImageDataSize As Long
Dim ResolutionW As Long
Dim ResolutionH As Long
Dim NumberOfPalets As Long
Dim PaletIndex As Long

'## 繰り返し用
Dim i As Long
Dim j As Long


'## 画像の幅,高さを画像データ配列から取得
ImageWidth = UBound(ImageData, 1) + 1
ImageHeight = UBound(ImageData, 2) + 1


'## ファイル先頭から画像データまでのオフセット
ImageDataOffSet = 54

'## ファイルサイズ = ヘッダ + 画像データ
FileSize = ImageDataOffSet + ImageWidth * ImageHeight * 3


'## 画像データを書き込み用データに変換(BMPデータは天地逆)
For i = ImageHeight - 1 To 0 Step -1

For j = 0 To ImageWidth - 1

'## BMPフォーマットはB,G,Rの順に並ぶ
ImageBinaryData(((ImageHeight - i - 1) * ImageWidth + j) * 3) = ImageData(i, j).B
ImageBinaryData(((ImageHeight - i - 1) * ImageWidth + j) * 3 + 1) = ImageData(i, j).G
ImageBinaryData(((ImageHeight - i - 1) * ImageWidth + j) * 3 + 2) = ImageData(i, j).R

Next

Next


'## ヘッダデータ
FileType = &H4D42 '## "BM"ビットマップ(リトルエンディアン)
ReservedA = 0 '## 予約領域
ReservedB = 0 '## 予約領域
HeaderSize = 40 '## 情報ヘッダサイズ
NumberOfPlanes = 1 '## プレーン数
RGBBit = 24 '## RGB合計ビット数(8*3)
CompressionFormat = 0 '## 圧縮形式
ImageDataSize = 0 '## 画像データ部のサイズ(非圧縮の場合は0で可)
ResolutionW = 0 '## 横解像度(0で可)
ResolutionH = 0 '## 縦解像度(0で可)
NumberOfPalets = 0 '## 格納されているパレット数
PaletIndex = 0 '## 重要なパレットのインデックス


'## ファイル番号
FileNumber = FreeFile()

'## BMPファイル新規作成
Open BMPFileName For Binary As #FileNumber

'## BMPヘッダー書き込み
Put #FileNumber, , FileType
Put #FileNumber, , FileSize
Put #FileNumber, , ReservedA
Put #FileNumber, , ReservedB
Put #FileNumber, , ImageDataOffSet
Put #FileNumber, , HeaderSize
Put #FileNumber, , ImageWidth
Put #FileNumber, , ImageHeight
Put #FileNumber, , NumberOfPlanes
Put #FileNumber, , RGBBit
Put #FileNumber, , CompressionFormat
Put #FileNumber, , ImageDataSize
Put #FileNumber, , ResolutionW
Put #FileNumber, , ResolutionH
Put #FileNumber, , NumberOfPalets
Put #FileNumber, , PaletIndex

'## 画像データ書き込み
For i = 0 To ImageWidth * ImageHeight * 3 - 1
Put #FileNumber, , ImageBinaryData(i)
Next

'## BMPファイルクローズ
Close #FileNumber

End Function


BMP作成マクロ素案

Sub Test_CreateBMP()

Dim bw As Long 'ビットマップの横幅
Dim bh As Long 'ビットマップの高さ

Dim fn As Integer 'ファイルNo.
Dim fs As Long 'ファイルサイズ
Dim w As Long
Dim h As Long
Dim tmp As Integer
Dim i As Integer

bw = 4
bh = 4

fn = FreeFile()
fs = 54 + bw * bh * 3

Open "F:\Test_CreateBMP.bmp" For Binary As #fn
Put #fn, , "BM" '0,1Byte目 ファイルタイプ
Put #fn, , fs '2,3,4,5Byte ファイルサイズ
Put #fn, , 0 '6,7Byte 予約領域
Put #fn, , 0 '8,9Byte 予約領域
Put #fn, , 54 'A,BByte ファイル先頭から画像データまでのオフセット
Put #fn, , 0 'C,DByte ファイル先頭から画像データまでのオフセット
Put #fn, , 40 'E,FByte 情報ヘッダのサイズ
Put #fn, , 0 '10,11Byte 情報ヘッダのサイズ
Put #fn, , bw '12,13,14,15Byte 画像の幅
Put #fn, , bh '16,17,18,19Byte 画像の高さ
Put #fn, , 1 '1A,1BByte 'プレーン数
Put #fn, , 24 '1C,1DByte 'RGB各色のbit数
Put #fn, , 0 '1E,1FByte 圧縮形式
Put #fn, , 0 '20,21Byte 圧縮形式
Put #fn, , 0 '22,23Byte '画像データ部のサイズ(非圧縮の場合は0で可)
Put #fn, , 0 '24,25Byte 画像データ部のサイズ
Put #fn, , 0 '26,27Byte 横方向解像度
Put #fn, , 0 '28,29Byte 横方向解像度
Put #fn, , 0 '2A,2BByte 縦方向解像度
Put #fn, , 0 '2C,2DByte 縦方向解像度
Put #fn, , 0 '2E,2FByte 格納されているパレット数
Put #fn, , 0 '30,31Byte 格納されているパレット数
Put #fn, , 0 '32,33Byte 重要なパレットのインデックス
Put #fn, , 0 '34,35Byte 重要なパレットのインデックス


'BGRの連続データ
For i = 1 To (bw * bh / 2)
Put #fn, , &HCC00 'GB
Put #fn, , &HFF 'BR
Put #fn, , &HFFCC 'RG
Next

Close #fn
End Sub

ExcelVBAによるBMP生成テスト

Option Explicit

Private Type BITMAPINFOHEADER '40バイト
biSize As Long 'イメージ バッファのバイト数
biWidth As Long '幅
biHeight As Long '高さ
biPlanes As Integer '常に1
biBitCount As Integer '1ピクセルあたりのカラービット数
biCompression As Long '圧縮方法
biSizeImage As Long 'ピクセルデータの全バイト数
biXPelsPerMeter As Long '0または水平解像度
biYPelsPerMeter As Long '0または垂直解像度
biClrUsed As Long 'ビットマップを表示するための色数(0)
biClrImportant As Long 'ビットマップを表示するための重要な色数(0)
End Type

Private Type RGBQUAD
rgbBlue As Byte '青の輝度
rgbGreen As Byte '緑の輝度
rgbRed As Byte '赤の輝度
rgbReserved As Byte '予約(常に0)
End Type

Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Private Type COLORREF
COLORREF As Long
End Type


Private Declare Function CreateDIBSection Lib "Gdi32" _
(ByVal hdc As Long, _
pbmi As BITMAPINFO, _
ByVal iUsage As Long, _
ByVal ppvbits As Long, _
ByVal hSection As Long, _
ByVal dwOffset As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "Gdi32" _
(ByVal hdc As Long, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer) As Long

Private Declare Function CreateCompatibleDC Lib "Gdi32" _
(ByVal hdc As Long) As Long

Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, _
ByVal yPoint As Long) As Long

Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long

Private Declare Function LineTo Lib "Gdi32" _
(ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long

Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, _
ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "Gdi32" _
(ByVal hObject As Long) As Long

Private Declare Function SelectObject Lib "Gdi32" _
(hdc As Long, _
hgdiobj As Long) As Long

Private Declare Function BitBlt Lib "Gdi32" _
(ByVal hdcDest As Long, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As Long, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As Long) As Long

Private Declare Function SetPixel Lib "Gdi32" _
(ByVal hdc As Long, _
ByVal x As Integer, _
ByVal y As Integer) As Long





Public Function CreateBitmap_Test()

Dim i As Integer
Dim j As Integer

'## ビットマップ構造体
Dim myBitmap As BITMAPINFO

'## ビットマップのハンドル
Dim Hundle_myBitmap As Long

'## メモリデバイスコンテキストのハンドル
Dim Hundle_myDC As Long


'## 作製する画像のメモリポインタ
Dim Pointer_myBitmap As Long

'## 対象ウインドウ のハンドル
Dim hTargetWin As Long

'## デバイスコンテキストへのハンドル
Dim hTargetDC As Long

'## 返り値の一時格納変数
Dim re As String

'## color構造体
Dim myColor As COLORREF


hTargetDC = GetDC(0)

Hundle_myBitmap = CreateCompatibleBitmap(hTargetDC, 256, 256)


Hundle_myDC = CreateCompatibleDC(hTargetDC)

re = SelectObject(Hundle_myDC, Hundle_myBitmap)

Call DeleteObject(Hundle_myBitmap)
Call ReleaseDC(hTargetWin, hTargetDC)


Dim hImageDisplayWin As Long
Dim hImageDisplayDC As Long


hImageDisplayWin = WindowFromPoint(300, 300)

hImageDisplayDC = GetDC(hImageDisplayWin)

If hImageDisplayDC = 0 Then

MsgBox ("失敗しました。")

Else


myColor.COLORREF = &H443344

Call BitBlt(hImageDisplayDC, 100, 100, 256, 256, Hundle_myBitmap, 0, 0, 0)

Call DeleteObject(hTargetWin)
Call DeleteObject(hImageDisplayWin)
Call DeleteObject(Hundle_myBitmap)


For i = 0 To 255
For j = 0 To 63
setpixel(hundle_mybitmap, i,j, )
Next
Next
x00bbggrr


Call ReleaseDC(hTargetWin, hTargetDC)
Call ReleaseDC(hImageDisplayWin, hImageDisplayDC)
Call ReleaseDC(Hundle_myBitmap, Hundle_myDC)

End If

End Function

ソフトウェアキーボード シート"キーコード一覧表"

Windowsのキーコード表,,,,
No.,"キー入力
(UserSendInput関数の引数)",定数名 ,キーの説明,仮想キーコード (10進数)
1,,  , ,0
2,LButton,VK_LBUTTON ,マウス左ボタン,1
3,RButton,VK_RBUTTON ,マウス右ボタン,2
4,,VK_CANCEL , ,3
5,MButton,VK_MBUTTON ,マウス中央ボタン,4
6,,VK_XBUTTON1 , ,5
7,,VK_XBUTTON2 , ,6
8,,  , ,7
9,BackSpace,VK_BACK ,BackSpace,8
10,Tab,VK_TAB ,TABキー,9
11,,  , ,10
12,,  , ,11
13,,VK_CLEAR , ,12
14,Enter,VK_RETURN ,リターン(Enter),13
15,,  , ,14
16,,  , ,15
17,Shift,VK_SHIFT ,Shift,16
18,Ctrl,VK_CONTROL ,Ctrl,17
19,Alt,VK_MENU ,Alt(GRPH),18
20,Pause,VK_PAUSE ,Pause,19
21,CapsLock,VK_CAPITAL ,CapsLock,20
22,カナ,VK_KANA,,21
23,,,,22
24,,VK_JUNJA , ,23
25,,VK_FINAL , ,24
26,漢字,VK_KANJI,,25
27,,,,26
28,Esc,VK_ESCAPE ,ESC,27
29,変換,VK_CONVERT ,変換,28
30,無変換,VK_NONCONVERT ,無変換,29
31,,VK_ACCEPT , ,30
32,,VK_MODECHANGE , ,31
33,Space,VK_SPACE ,スペースバー,32
34,PageUp,VK_PRIOR ,PageUp(RollDown),33
35,PageDown,VK_NEXT ,PageDown(RollUp),34
36,End,VK_END ,End(Help),35
37,Home,VK_HOME ,Home,36
38,Left,VK_LEFT ,←,37
39,Up,VK_UP ,↑,38
40,Right,VK_RIGHT ,→,39
41,Down,VK_DOWN ,↓,40
42,,VK_SELECT , ,41
43,,VK_PRINT , ,42
44,,VK_EXECUTE , ,43
45,PrtSc,VK_SNAPSHOT ,PrintScreen(COPY),44
46,Insert,VK_INSERT ,Insert,45
47,Delete,VK_DELETE ,Delete,46
48,,VK_HELP , ,47
49,0,'0' ,0,48
50,1,'1' ,1,49
51,2,'2' ,2,50
52,3,'3' ,3,51
53,4,'4' ,4,52
54,5,'5' ,5,53
55,6,'6' ,6,54
56,7,'7' ,7,55
57,8,'8' ,8,56
58,9,'9' ,9,57
59,,  , ,58
60,,  , ,59
61,,  , ,60
62,,  , ,61
63,,  , ,62
64,,  , ,63
65,,  , ,64
66,a,'A' ,A,65
67,b,'B' ,B,66
68,c,'C' ,C,67
69,d,'D' ,D,68
70,e,'E' ,E,69
71,f,'F' ,F,70
72,g,'G' ,G,71
73,h,'H' ,H,72
74,i,'I' ,I,73
75,j,'J' ,J,74
76,k,'K' ,K,75
77,l,'L' ,L,76
78,m,'M' ,M,77
79,n,'N' ,N,78
80,o,'O' ,O,79
81,p,'P' ,P,80
82,q,'Q' ,Q,81
83,r,'R' ,R,82
84,s,'S' ,S,83
85,t,'T' ,T,84
86,u,'U' ,U,85
87,v,'V' ,V,86
88,w,'W' ,W,87
89,x,'X' ,X,88
90,y,'Y' ,Y,89
91,z,'Z' ,Z,90
92,LWin,VK_LWIN ,左Windowsキー,91
93,RWin,VK_RWIN ,右Windowsキー,92
94,Apps,VK_APPS ,アプリケーションキー,93
95,,  , ,94
96,,VK_SLEEP , ,95
97,Numpad0,VK_NUMPAD0 ,Num 0,96
98,Numpad1,VK_NUMPAD1 ,Num 1,97
99,Numpad2,VK_NUMPAD2 ,Num 2,98
100,Numpad3,VK_NUMPAD3 ,Num 3,99
101,Numpad4,VK_NUMPAD4 ,Num 4,100
102,Numpad5,VK_NUMPAD5 ,Num 5,101
103,Numpad6,VK_NUMPAD6 ,Num 6,102
104,Numpad7,VK_NUMPAD7 ,Num 7,103
105,Numpad8,VK_NUMPAD8 ,Num 8,104
106,Numpad9,VK_NUMPAD9 ,Num 9,105
107,NumpadMut,VK_MULTIPLY ,Num *,106
108,NumpadAdd,VK_ADD ,Num +,107
109,NumpadSep,VK_SEPARATOR ,"Num ,",108
110,NumpadSub,VK_SUBTRACT ,Num -,109
111,NumpadDec,VK_DECIMAL ,Num .,110
112,NumpadDiv,VK_DIVIDE ,Num /,111
113,F1,VK_F1 ,F1,112
114,F2,VK_F2 ,F2,113
115,F3,VK_F3 ,F3,114
116,F4,VK_F4 ,F4,115
117,F5,VK_F5 ,F5,116
118,F6,VK_F6 ,F6,117
119,F7,VK_F7 ,F7,118
120,F8,VK_F8 ,F8,119
121,F9,VK_F9 ,F9,120
122,F10,VK_F10 ,F10,121
123,F11,VK_F11 ,F11,122
124,F12,VK_F12 ,F12,123
125,F13,VK_F13 ,F13,124
126,F14,VK_F14 ,F14,125
127,F15,VK_F15 ,F15,126
128,F16,VK_F16 ,F16,127
129,F17,VK_F17 ,F17,128
130,F18,VK_F18 ,F18,129
131,F19,VK_F19 ,F19,130
132,F20,VK_F20 ,F20,131
133,F21,VK_F21 ,F21,132
134,F22,VK_F22 ,F22,133
135,F23,VK_F23 ,F23,134
136,F24,VK_F24 ,F24,135
137,,  , ,136
138,,  , ,137
139,,  , ,138
140,,  , ,139
141,,  , ,140
142,,  , ,141
143,,  , ,142
144,,  , ,143
145,NumLock,VK_NUMLOCK ,NumLock,144
146,ScrollLock,VK_SCROLL ,ScrollLock,145
147,,  ,Num =,146
148,,  , ,147
149,,  , ,148
150,,  , ,149
151,,  , ,150
152,,  , ,151
153,,  , ,152
154,,  , ,153
155,,  , ,154
156,,  , ,155
157,,  , ,156
158,,  , ,157
159,,  , ,158
160,,  , ,159
161,LShift,VK_LSHIFT ,左Shift,160
162,RShift,VK_RSHIFT ,右Shift,161
163,LCtrl,VK_LCONTROL ,左Ctrl,162
164,RCtrl,VK_RCONTROL ,右Ctrl,163
165,LAlt,VK_LMENU ,左Alt,164
166,RAlt,VK_RMENU ,右Alt,165
167,BrowserBack,VK_BROWSER_BACK , ,166
168,BrowserForward,VK_BROWSER_FORWARD , ,167
169,BrowserRefresh,VK_BROWSER_REFRESH , ,168
170,BrowserStop,VK_BROWSER_STOP , ,169
171,BrowserSearch,VK_BROWSER_SEARCH , ,170
172,BrowserFavorites,VK_BROWSER_FAVORITES , ,171
173,BrowserHome,VK_BROWSER_HOME ,"ブラウザスタート, ホーム表示 ",172
174,VolumeMute,VK_VOLUME_MUTE , ,173
175,VolumeDown,VK_VOLUME_DOWN , ,174
176,VolumeUp,VK_VOLUME_UP , ,175
177,MediaNext,VK_MEDIA_NEXT_TRACK , ,176
178,MediaPrev,VK_MEDIA_PREV_TRACK , ,177
179,MediaStop,VK_MEDIA_STOP , ,178
180,MediaPause,VK_MEDIA_PLAY_PAUSE , ,179
181,LaunchMail,VK_LAUNCH_MAIL , ,180
182,SelectMedia,VK_LAUNCH_MEDIA_SELECT , ,181
183,LaunchApp1,VK_LAUNCH_APP1 , ,182
184,LaunchApp2,VK_LAUNCH_APP2 , ,183
185,,  , ,184
186,,  , ,185
187,;,VK_OEM_1 ,:(シフトで*),186
188,+,VK_OEM_PLUS ,;(シフトで+),187
189,",",VK_OEM_COMMA ,",(シフトで<)",188
190,-,VK_OEM_MINUS ,-(シフトで=),189
191,.,VK_OEM_PERIOD ,.(シフトで>),190
192,/,VK_OEM_2 ,/(シフトで>),191
193,`,VK_OEM_3 ,@(シフトで`),192
194,,  , ,193
195,,  , ,194
196,,  , ,195
197,,  , ,196
198,,  , ,197
199,,  , ,198
200,,  , ,199
201,,  , ,200
202,,  , ,201
203,,  , ,202
204,,  , ,203
205,,  , ,204
206,,  , ,205
207,,  , ,206
208,,  , ,207
209,,  , ,208
210,,  , ,209
211,,  , ,210
212,,  , ,211
213,,  , ,212
214,,  , ,213
215,,  , ,214
216,,  , ,215
217,,  , ,216
218,,  , ,217
219,,  , ,218
220,[,VK_OEM_4 ,[(シフトで{),219
221,\,VK_OEM_5 ,\(シフトで|),220
222,],VK_OEM_6 ,](シフトで}),221
223,^,VK_OEM_7 ,^(~),222
224,,VK_OEM_8 ,,223
225,,  , ,224
226,,VK_OEM_AX , ,225
227,_,VK_OEM_102 ,\[シフトで_),226
228,,VK_ICO_HELP , ,227
229,,VK_ICO_00 , ,228
230,,VK_PROCESSKEY , ,229
231,,VK_ICO_CLEAR , ,230
232,,VK_PACKET , ,231
233,,  , ,232
234,,VK_OEM_RESET , ,233
235,,VK_OEM_JUMP , ,234
236,,VK_OEM_PA1 , ,235
237,,VK_OEM_PA2 , ,236
238,,VK_OEM_PA3 , ,237
239,,VK_OEM_WSCTRL , ,238
240,,VK_OEM_CUSEL , ,239
241,,VK_OEM_ATTN , ,240
242,,VK_OEM_FINISH , ,241
243,,VK_OEM_COPY , ,242
244,,VK_OEM_AUTO , ,243
245,,VK_OEM_ENLW , ,244
246,,VK_OEM_BACKTAB , ,245
247,,VK_ATTN , ,246
248,,VK_CRSEL , ,247
249,,VK_EXSEL , ,248
250,,VK_EREOF , ,249
251,,VK_PLAY , ,250
252,,VK_ZOOM , ,251
253,,VK_NONAME , ,252
254,,VK_PA1 , ,253
255,,VK_OEM_CLEAR , ,254
256,,  , ,255

ソフトウェアキーボード ユーザーフォーム

Option Explicit

Private Sub CommandButton1_Click()
Dim i As Integer '繰返し用変数
Dim MousePosition As Point 'マウスポインタ座標を格納
Dim CornerPosition As Point
Dim X As Integer 'マウスポインタ位置のX座標
Dim Y As Integer 'マウスポインタ位置のY座標

GetCursorPos CornerPosition

'マウスが右端にあるとき文字入力
'マウスが左端にいくとマクロ停止
Do
'ソフトウェアキーボード上のマウスポインタ位置を取得
GetCursorPos MousePosition
X = MousePosition.X - CornerPosition.X
Y = MousePosition.Y - CornerPosition.Y
'(x, y)座標をセルに書き出す
Range("b2").Value = X
Range("c2").Value = Y

'マウスが右端にあるか判定
If X > 500 Then
'文字入力
UserSendInput ("kakinotane")
'時間稼ぎ
Sleep 200
End If

'マウスが左端にあるか判定
If X < 0 Then
'マクロ停止フラグを立てる
SOFTWAREKEYBOARD_END = 1
End If
Sleep 10
Loop Until SOFTWAREKEYBOARD_END = 1

End Sub

ソフトウェアキーボード 標準モジュール

Option Explicit

'ユーザー定義 構造体
Public Type KEYBDINPUT
wVk As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
dummy1 As Long
dummy2 As Long
End Type

Public Type INPUT_TYPE
dwType As Long
ki As KEYBDINPUT
End Type

Public Type Point
X As Long
Y As Long
End Type

Public Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


'ユーザー定義 名前
Public Const KEYEVENTF_KEYDOWN As Integer = 0
Public Const KEYEVENTF_KEYUP As Integer = 2
Public Const INPUT_KEYBOARD As Integer = 1

'共有変数
Public SOFTWAREKEYBOARD_END As Integer

'入力キーコード取得API
Public Declare Function GetAsyncKeyState Lib "user32.dll" _
(ByVal vKey As Long) As Long
'仮想キー入力を合成するAPI
Public Declare Function SendInput Lib "user32.dll" _
(ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbsize As Long) As Long
'処理一時停止API
Public Declare Sub Sleep Lib "kernel32.dll" _
(ByVal dwMilliseconds As Long)
'仮想キーコード, ASCII値, スキャンコード相互にコード変換するAPI
Public Declare Function MapVirtualKey Lib "user32.dll" Alias "MapVirtualKeyA" _
(ByVal wCode As Long, ByVal wMapType As Long) As Long
'マウスポインタの位置を取得するAPI
Public Declare Function GetCursorPos Lib "user32.dll" _
(lpPoint As Point) As Long
''マウスポインタを指定の位置に動かすAPI
'Public Declare Function SetCursorPos Lib "user32.dll" _
' (ByVal X As Long, ByVal Y As Long) As Long
''フォームサイズを取得するAPI
'Public Declare Function GetWindowRect Lib "user32.dll" _
' (ByVal hWnd As Long, lpRect As Rect) As Long


'ユーザー定義 関数
Sub UserSendInput(ByVal InputKey As String)

Dim InputKeyName(64) As String '入力キーの名前を格納する(受け付ける文字は最大4文字)
Dim InputKeyCode(64) As Integer '入力キーのキーコードを格納する
Dim inputevents(128) As INPUT_TYPE '1つのキーにつきUp,Downの2回処理が必要
Dim InputKeyLength As Integer '入力キーの文字数を格納する
Dim KeyCodeMap As Range 'キーコード表の範囲
Dim i As Integer '繰返し用変数
Dim j As Integer '繰返し用変数

' On Error Resume Next 'エラー発生しても処理を止めず、次に移る

InputKeyLength = Len(InputKey) '入力キーの文字数を取得

'参照するキーコード一覧表の範囲を指定
Set KeyCodeMap = ThisWorkbook.Worksheets("キーコード一覧表").Range("B3:E400")

For i = 0 To InputKeyLength - 1
'最大4文字の入力キーを先頭から1文字ずつばらす
InputKeyName(i) = Left(InputKey, 1)
InputKey = Mid(InputKey, 2, 64)
'ばらした文字のキーコードを"マウスでソフトウェアキーボード"のシートからvlookup関数で取得する
InputKeyCode(i) = Application.WorksheetFunction.VLookup(InputKeyName(i), KeyCodeMap, 4, False)
Next


'4つのキーを順番に押し下げる
'修飾キーを使えるように、1つ目のキーを押し下げたままの状態で次のキーを押していく
For j = 0 To InputKeyLength - 1
i = j 'InputKeyCode(i)の配列番号
With inputevents(j)
.dwType = INPUT_KEYBOARD 'キーボードによる入力であることを定義
With .ki '入力キーの詳細について
.wVk = InputKeyCode(i) 'キーコードの指定
.wScan = MapVirtualKey(InputKeyCode(i), 0) 'ハードウェアレベル(?)のキーコード指定
.dwFlags = KEYEVENTF_KEYDOWN '入力キーを"押し下げる"ことを指定
.time = 0 'よく分からないがデフォルト値を指定
.dwExtraInfo = 0 '+αの送れるらしいがここでは無しと指定
End With
End With
Next

'4つ目の入力キーからUpさせる
'最後に押すキーは文字キーやTabキーやらの動作を指示するキーのことが多いので、
'修飾キーより先に離しておく方が予期せぬ動作を防げる
For j = InputKeyLength To InputKeyLength * 2 - 1
i = InputKeyLength * 2 - 1 - j 'InputKeyCode(i)の配列番号(4つ目の入力キーからUp)
With inputevents(j)
.dwType = INPUT_KEYBOARD
With .ki
.wVk = InputKeyCode(i)
.wScan = MapVirtualKey(InputKeyCode(i), 0)
.dwFlags = KEYEVENTF_KEYUP
.time = 0
.dwExtraInfo = 0
End With
End With
Next

Call SendInput(InputKeyLength, inputevents(0), Len(inputevents(0)))

End Sub




Ssendinput

Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Long
'入力キーコード取得API
Public Declare Function SendInput Lib "user32.dll" _
(ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbsize As Long) As Long
'仮想キー入力を合成するAPI
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
'処理一時停止API
Public Declare Function MapVirtualKey Lib "user32.dll" Alias "MapVirtualKeyA" _
(ByVal wCode As Long, ByVal wMapType As Long) As Long
'仮想キーコード, ASCII値, スキャンコード相互にコード変換するAPI


'ユーザー定義 構造体
Public Type KEYBDINPUT
wVk As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
dummy1 As Long
dummy2 As Long
End Type

Public Type INPUT_TYPE
dwType As Long
ki As KEYBDINPUT
End Type


'ユーザー定義 名前
Public Const KEYEVENTF_KEYDOWN As Integer = 0
Public Const KEYEVENTF_KEYUP As Integer = 2
Public Const INPUT_KEYBOARD As Integer = 1


'ユーザー定義 関数
Sub UserSendInput(ByVal Key As String)

Dim inputevents(2) As INPUT_TYPE
Dim i As Integer
Dim InputKeyCode As Integer

Sheets("キーコード一覧").Cells(2, 2).Value = Key
InputKeyCode = Sheets("キーコード一覧").Cells(3, 2).Value

With inputevents(0)
.dwType = INPUT_KEYBOARD
With .ki
.wVk = InputKeyCode
.wScan = MapVirtualKey(InputKeyCode, 0)
.dwFlags = KEYEVENTF_KEYDOWN
.time = 0
.dwExtraInfo = 0
End With
End With

With inputevents(1)
.dwType = INPUT_KEYBOARD
With .ki
.wVk = InputKeyCode
.wScan = MapVirtualKey(InputKeyCode, 0)
.dwFlags = KEYEVENTF_UP
.time = 0
.dwExtraInfo = 0
End With
End With

Call SendInput(2, inputevents(0), Len(inputevents(0)))

End Sub


0

ユニクロビックカメラにはかのピッコロもビックロこいた

ナイジェリア人は猜疑心が強く現金をあまり持たないという犯罪に詳しい人の話。
Java7の登場も脆弱なところをTrojan.Rodricterにつつかれて脇腹が痛い。
20代の過半数はスマホ所持してスマンほんとに。
4世帯住宅のやしゃごは消費電力1/20の冷めたやつ、食事1回で10日働くと豪語。
エアドロップは冷静を装い結露を謳歌する砂漠のナミブビートルをリスペクトし、空気1m3から水11.5mlを絞り出す。
電子黒板が50台のタブレットと結ばれる一夫多妻制。
大津のいじめ、「やりすぎるなよ」と教師のお墨付きでお手付き。

タスク(7)

イケメンを優先するか、お宅にうかがってオタクを楽しんでもよろしいでしょうか。