プログラミング学習支援

Program Samples(サンプルプログラム)
[JavaScript] ドラッグしてドット絵を描こう
<!--2019/5/5 K.Narita-->
<!DOCTYPE html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<script type="text/javascript">
function mousemove(e){
var str = "X座標:" + e.pageX + " Y座標:" + e.pageY;
document.getElementById("xy").innerText = str;
}
var flg = false;
window.document.onmousemove=move;
window.document.onmouseup=up;
function down($event){
flg =true;
}
function up(){
flg = false;
}
function move($event){
var str = "X座標:" + ($event.clientX) + " Y座標:" + ($event.clientY);
document.getElementById("xy").innerText = str;
var x, y, n=50, obj;
x=(($event.clientX));
y=(($event.clientY));
x=Math.floor(x/30);
y=Math.floor(y/30);
if(0<=x && x<16 && 0<=y && y<16){
n=y*16+x;
obj=document.getElementById("square"+n);
if(flg){
obj.src="black.png";
}
}
return false;
}
</script>
<title>JavaScript研究vol.1</title>
</head>
<body>
<div id="canvas"></div>
<div id = "xy" style ="position:absolute; left:10px;top:550px;width:200px; hight:100px;background-color: #99cc00;" onmousemove="mousemove(event);">
座標</div>
<script type="text/javascript">
var x,y,n=0,tag="";
for(y=10; y<=480;y+=30){
for(x=10; x<=480; x+=30){
tag+="<img id='square"+n+"' src='white.png' style ='position:absolute; left:"+x+"px;top:"+y+"px' onMouseDown='down()' />";
n++;
}
}
document.getElementById("canvas").innerHTML=tag;
</script>
</body>
</html>


[excel VBA]
Excel で波形データの最大値前後5件(ピンクの枠)
データを新しいシートにコピーする
1.波形データのy軸が0の位置のExcelシートの行番号を配列に格納する(min配列)
2.min配列の行データからピボットを中心に最大値の行番号を探索する
3.探索した最大値前後5件ずつ、合計10件のデータを新しいシートにコピーする
Sub test()
Dim sRow As Long
Dim eRow As Long
eRow = maxV(2, minV(100, 0)) + 5
sRow = maxV(2, minV(100, 0)) - 5
Call newSheetAdd(sRow, eRow)
End Sub
'戻り値(min配列)を返すFunctionプロシージャ
Function minV(rlengs As Long, w As Long) As Long
Dim s As Double
Dim i, j, rowmin(10) As Long
s = Cells(2, 7)
j = 0
For i = 3 To rlengs
If (Cells(i, 7) = 0) Or (Cells(i, 7) = 0.1) Then
rowmin(j) = i
j = j + 1
If j >= 10 Then
Exit For
End If
End If
Next i
Debug.Print ("Max : " & rowmax)
For i = 0 To 3
Debug.Print (rowmin(i))
Next i
minV = rowmin(w)
End Function
’最大値の行番号を探すFunctionプロシージャ
Function maxV(start As Long, last As Long) As Long
Dim i, rowmax, temp As Long
Dim s As Double
rowmax = Int((last - start) / 2)
s = Cells(rowmax, 7)
For i = rowmax To last
If Cells(i, 7) > s Then
s = Cells(i, 7)
temp = i
End If
Next i
For i = rowmax To start + 2 Step -1
If Cells(i, 7) > s Then
s = Cells(i, 7)
temp = i
End If
Next i
maxV = temp
Debug.Print s & ":" & rowmax & ";"
End Function
’新しいシートに最大値から前後5件のデータをコピーする
Sub newSheetAdd(sRow As Long, eRow As Long)
' セル範囲を取得
Dim selectedRange As Range
On Error Resume Next
Set selectedRange = Range(Cells(sRow, 6), Cells(eRow, 7))
On Error GoTo 0
' セル範囲が選択されていない場合は終了
If selectedRange Is Nothing Then
MsgBox "セル範囲が選択されていません。", vbExclamation
Exit Sub
End If
' 新しいシートを作成
Dim newSheet As Worksheet
Set newSheet = Sheets.Add
' 選択したセル範囲を新しいシートにコピー
selectedRange.Copy Destination:=newSheet.Range("A1")
' コピーが完了した旨のメッセージを表示
MsgBox "セル範囲が新しいシートにコピーされました。", vbInformation
End Sub
[VBScript]
ファイル名を変更してファイルをコピーする
① メモ帳で以下を入力して保存「test.vbs」 拡張子は「vbs」
② "C:\Users\Owner\Pictures\images\"フォルダのpngファイルを"C:\Users\Owner\Pictures\images\test(1からの連番).png"として保存
Option Explicit
Dim objFileSys
Dim objFolder
Dim objFile
Dim objOutputTextStream
Dim strFilePathFrom
Dim strFilePathTo
Dim i
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'第2引数は 1 :読み取り、2 :上書き、3 :追記。
Set objOutputTextStream = objFileSys.OpenTextFile("log.txt", 2, True)
Set objFolder = objFileSys.GetFolder("C:\Users\Owner\Pictures\images")
i = 1
For Each objFile In objFolder.Files
objOutputTextStream.WriteLine objFile.Name
strFilePathFrom = "C:\Users\Owner\Pictures\images\" & objFile.Name
strFilePathTo = "C:\Users\Owner\Pictures\images\test" & CStr(i) & ".png"
On Error Resume Next
Call objFileSys.CopyFile(strFilePathFrom, strFilePathTo, true)
If Err.Number <> 0 Then
Err.Clear
End If
'「On Error Resume Next」を解除
On Error Goto 0
i = i + 1
Next
objOutputTextStream.Close
Set objOutputTextStream = Nothing
Set objFolder = Nothing
Set objFileSys = Nothing
