～蛙が跳ぶ程度の更新速度～
Option Explicit
WScript.Sleep(1000)
’2016：16
’2010：14
’2003：11
Dim objParam
Dim strFilename
Dim strPassword
Dim objExcel
Dim objOpendExcel
Set objParam = WScript.Arguments
strFilename = "FileAddress"'objParam(0)
strPassword = "0000"'objParam(1)
Set objExcel = CreateObject("Excel.Application.16")
objExcel.Visible = True
Set objOpendExcel = objExcel.Workbooks.Open(strFilename,,,,strPassword)
Set objExcel = Nothing
再読み込み用にスリープさせているが、エクセルアプリケーション系が上手く起動しない事があるらしく、完全な対応が出来ない。起動バージョンによって16のところの数字変更。
００００はパスワード。
WSHでソフト指定して起動した方が早いし汎用性は高いのだけれど、エクセルアプリケーション系の関数なら当該ファイルのみとか、既に開いている場合はブック足すとか出来ないかなと微調整方法がないか確認している途中。オプションで有れば良いんだけど、バージョンによってブックが作られたり、ファイル選択画面が出てきたりまちまちで、対応に幅が出来るのが難しいところ。
とりあえず使う事があるのでメモ的に。
再読み込み用にスリープさせているが、エクセルアプリケーション系が上手く起動しない事があるらしく、完全な対応が出来ない。起動バージョンによって16のところの数字変更。
００００はパスワード。
WSHでソフト指定して起動した方が早いし汎用性は高いのだけれど、エクセルアプリケーション系の関数なら当該ファイルのみとか、既に開いている場合はブック足すとか出来ないかなと微調整方法がないか確認している途中。オプションで有れば良いんだけど、バージョンによってブックが作られたり、ファイル選択画面が出てきたりまちまちで、対応に幅が出来るのが難しいところ。
とりあえず使う事があるのでメモ的に。
PR
ネットで拾ったソースコードをエクセル2016で使えるように改修したもの。
このおもちゃに一時間かかったと思うとかけすぎである。
まぁ 試してもらえれば効果は分かる。あと明度や彩度まで回転式になってるので、
嫌な人はSとVの値を０〜１００になるようにクリップするなりコンプ作るなりしてくれろ。
とりあえず以下ソース。モジュールは分けてもらわないとテスト関数が暴発するはず。
’まず計算用モジュール。
Function Bigger(ByVal A As Single, B As Single)
’次に色変換系
’で、飾りで表示行検索
このおもちゃに一時間かかったと思うとかけすぎである。
まぁ 試してもらえれば効果は分かる。あと明度や彩度まで回転式になってるので、
嫌な人はSとVの値を０〜１００になるようにクリップするなりコンプ作るなりしてくれろ。
とりあえず以下ソース。モジュールは分けてもらわないとテスト関数が暴発するはず。
’まず計算用モジュール。
Function Bigger(ByVal A As Single, B As Single)
Max = A
If A < B Then
Max = B
Else
End If
Bigger = Max
End Function
Function Smaller(ByVal A As Single, B As Single)
Dim min
min = A
If A > B Then
min = B
Else
End If
Smaller = min
End Function
Sub test()
Dim Data(4) As Variant
' Data(0) = 0
' Data(1) = 1
Data(2) = 2
' Data(3) = 3
Data(4) = 4
' MsgBox "Max:" & Maximam(Data) & " ,Min:" & Minimam(Data)
MsgBox "Max:" & Data(Biggest(Data)) & " ,Min:" & Data(Smallest(Data))
End Sub
Function Biggest(ByVal InData)
'最大値の入っていた配列番号を返す
Dim crntmax
Dim n
For n = 0 To UBound(InData)
If InData(n) = "" Then
Else
Exit For
End If
Next
crntmin = InData(LBound(InData) + n)
For i = LBound(InData) + n To UBound(InData)
If UBound(InData) - LBound(InData) = i Then
Exit For
End If
If InData(i) < InData(i + 1) Then
' crntmax = InData(i + 1)
crntmax = i + 1
End If
Next
Biggest = crntmax
End Function
Function Smallest(ByVal InData)
'空白以外の最小値の配列番号を返す
Dim crntmin
Dim n
For n = 0 To UBound(InData)
If InData(n) = "" Then
Else
Exit For
End If
Next
crntmin = InData(LBound(InData) + n)
For i = LBound(InData) + n To UBound(InData)
If UBound(InData) - LBound(InData) = i Then
Exit For
End If
If InData(i + 1) = "" Then
ElseIf InData(i) > InData(i + 1) Then
' crntmin = InData(i + 1)
crntmin = i + 1
End If
Next
Smallest = crntmin
End Function
’次に色変換系
Sub TestColor()
Dim BaseColor As Long
Dim RGBData As Long
Dim H As Single, S As Single, V As Single
Dim Rad As Long
Dim Sat As Long
Dim Val As Long
Dim rgb
Rad = 12
Val = -10
Sat = 10
BaseColor = ThisWorkbook.ActiveSheet.Range("B3").Interior.Color
For i = 1 To 30
ThisWorkbook.ActiveSheet.Range("B3").Offset(i, 0).Interior.Color = ChgColorHue(BaseColor, Rad * i)
ThisWorkbook.ActiveSheet.Range("A3").Offset(i, 0).Interior.Color = MonoTone(ThisWorkbook.ActiveSheet.Range("B3").Offset(i, 0).Interior.Color)
Next
ThisWorkbook.ActiveSheet.Range("C3").Interior.Color = ChgColorVal(BaseColor, Val)
ThisWorkbook.ActiveSheet.Range("C4").Interior.Color = ChgColorSat(BaseColor, Sat)
End Sub
Sub testrgbVal()
Dim rgb As Variant
rgb = RevRGB(ThisWorkbook.ActiveSheet.Range("B3").Interior.Color)
MsgBox "RGB(" & rgb(1) & "," & rgb(2) & "," & rgb(3) & ")"
End Sub
Function RevRGB(Color As Long) As Variant
'RGBを配列で返す
Dim c, rgb(3) As Variant
c = Right("000000" & Hex(Color), 6)
rgb(1) = Val("&H" & Right(c, 2))
rgb(2) = Val("&H" & Mid(c, 3, 2))
rgb(3) = Val("&H" & Left(c, 2))
RevRGB = rgb
'MsgBox "RGB(" & r & "," & g & "," & B & ")"
End Function
Function MonoTone(ByVal Color) As Long
Dim RGBData As Long
Dim H As Single, S As Single, V As Single
Call RGB_ToHSV(Color, H, S, V)
' H = 0
S = 0
Call RGB_FromHSV(RGBData, H, S, V)
MonoTone = RGBData
End Function
Function ChgColorHue(ByVal Color As Long, Rad As Long) As Long
Dim RGBData As Long
Dim H As Single, S As Single, V As Single
Call RGB_ToHSV(Color, H, S, V)
H = (H + Rad) Mod 360
Call RGB_FromHSV(RGBData, H, S, V)
ChgColorHue = RGBData
End Function
Function ChgColorSat(ByVal Color As Long, Sat As Long) As Long
Dim RGBData As Long
Dim H As Single, S As Single, V As Single
Call RGB_ToHSV(Color, H, S, V)
S = (S + Sat) Mod 100
Call RGB_FromHSV(RGBData, H, S, V)
ChgColorSat = RGBData
End Function
Function ChgColorVal(ByVal Color As Long, Val As Long) As Long
Dim RGBData As Long
Dim H As Single, S As Single, V As Single
Call RGB_ToHSV(Color, H, S, V)
V = (V + Val) Mod 100
Call RGB_FromHSV(RGBData, H, S, V)
ChgColorVal = RGBData
End Function
Sub RGB_ToHSV(ByVal iiRGB As Long, ByRef orH As Single, ByRef orS As Single, ByRef orV As Single)
Dim rR As Single, rG As Single, rB As Single
Dim rKr As Single, rKg As Single, rKb As Single
Dim rMin As Single, rDiff As Single
Dim c As String
rMin = 1
orV = 0
'' ３原色を分離して百分率に。
c = Right("000000" & Hex(iiRGB), 6)
rR = Val("&H" & Right(c, 2))
rR = rR / 255
rG = Val("&H" & Mid(c, 3, 2))
rG = rG / 255
rB = Val("&H" & Left(c, 2))
rB = rB / 255
'' 明度は、RGB 各要素の最大のものと同等です。
orV = Bigger(rG, rB)
orV = Bigger(rR, orV)
'' 彩度は、RGB 各要素の最小と最大の差を、最大で割ったもの。
rMin = Smaller(rG, rB)
rMin = Smaller(rR, rMin)
rDiff = orV - rMin
If orV <> 0 Then
orS = (rDiff / orV)
Else
orS = 0
End If
'' 色相は、どの値が最大値だったかにより違い、以下の計算で求まります。
'' 最大の値により、色相角が決まるのです。
'' またここで、0 =< and < 360 の範囲に収めます。
'' ただし、色がなければ、色相はゼロです。
If orS = 0 Then
orH = 0
Else
rKr = (orV - rR) / rDiff
rKg = (orV - rG) / rDiff
rKb = (orV - rB) / rDiff
Select Case orV
Case rR: orH = rKb - rKg
Case rG: orH = 2 + rKr - rKb
Case rB: orH = 4 + rKg - rKr
End Select
orH = orH * 60: If orH < 0 Then orH = orH + 360
End If
'' 明度・彩度を 0 ～ 100 にします。
orV = orV * 100
orS = orS * 100
End Sub
Sub RGB_FromHSV(ByRef oiRGB As Long, ByVal irH As Single, ByVal irS As Single, ByVal irV As Single)
Dim rR As Single, rG As Single, rB As Single
Dim iI As Integer
Dim rF As Single, rP As Single, rQ As Single, rT As Single
'' 数値を 1 以下に収めます。
irS = irS / 100
irV = irV / 100
If irS = 0 Then
rR = irV
rG = irV
rB = irV
Else
irH = irH / 60
If irH = 6 Then irH = 0
iI = Int(irH)
rF = irH - iI
rP = irV * (1 - irS)
rQ = irV * (1 - irS * rF)
rT = irV * (1 - (irS * (1 - rF)))
Select Case iI
Case 0: rR = irV: rG = rT: rB = rP
Case 1: rR = rQ: rG = irV: rB = rP
Case 2: rR = rP: rG = irV: rB = rT
Case 3: rR = rP: rG = rQ: rB = irV
Case 4: rR = rT: rG = rP: rB = irV
Case 5: rR = irV: rG = rP: rB = rQ
End Select
End If
oiRGB = rgb(Int(rR * 255.9999), Int(rG * 255.9999), Int(rB * 255.9999))
End Sub
’で、飾りで表示行検索
Function NextVisibleRow(ByVal CrntRow As Range, UorL) As Range
If UorL = U Then
For NofR = 1 To 1000
If CrntRow.Offset(-NofR, 0).EntireRow.Hidden = False Then
Exit For
End If
Next
Set NextVisibleRow = CrntRow.Offset(-NofR, 0)
Else
For NofR = 1 To 10000
If CrntRow.Offset(NofR, 0).EntireRow.Hidden = False Then
Exit For
End If
Next
Set NextVisibleRow = CrntRow.Offset(NofR, 0)
End If
End Function
Function NextVisibleCol(ByVal CrntCol As Range, LorR) As Range
If LorR = L Then
For NofC = 1 To 1000
If CrntCol.Offset(-NofC, 0).EntireColumn.Hidden = False Then
Exit For
End If
Next
Set NextVisibleCol = CrntCol.Offset(-NofC, 0)
Else
For NofC = 1 To 1000
If CrntCol.Offset(NofC, 0).EntireColumn.Hidden = False Then
Exit For
End If
Next
Set NextVisibleCol = CrntCol.Offset(NofC, 0)
End If
End Function
Sub test()
Dim tgtrow As Range
Set tgtrow = NextVisibleRow(Range("A9"), U)
MsgBox tgtrow.Address
End Sub
題名の通り。例えば絵を描くであったり、写真を撮るであったり、
意図の実現方法はおいといて、まず意図を作るというのがまた難しい。
要するにそれをする理由をもっておかないと何も前に進まないんだけど、
いかんせん感情なんてものがあるもんで、それは理由の前の目的のはず。
で、目的を理由と取り違えて突き進んで論点が安定しない。
なんてことがよくあるわけで。それを治すにはもはや常に意図をもって
行動する以外にないはずなんだよな。
できない。
オーディオ組むのも方向性って言われるように、目標の音があって、
意図があって、方法によって改善する。
カメラだったらピントの浅いものはいい写真に見えるけど、
ピントが深くても同じように意図を押し出せないと上手くならないわけで。
これが不足するとこれがいい。で終わって、何故いいのか理解しないから、
次に手を出した時に路頭に迷う。
日常に加えて何か効果的なトレーニング方法がないか
という、楽をしたいくそみたいな根性が首をもたげているわけだけど、
割と真面目になんかないもんかね。
こういうのって文書しかり、芸術しかり、表現全般に言えるんだよな。
あ。誕生日は無事（何事もなく）終わりました。はい。
そんな感じの生存報告。
意図の実現方法はおいといて、まず意図を作るというのがまた難しい。
要するにそれをする理由をもっておかないと何も前に進まないんだけど、
いかんせん感情なんてものがあるもんで、それは理由の前の目的のはず。
で、目的を理由と取り違えて突き進んで論点が安定しない。
なんてことがよくあるわけで。それを治すにはもはや常に意図をもって
行動する以外にないはずなんだよな。
できない。
オーディオ組むのも方向性って言われるように、目標の音があって、
意図があって、方法によって改善する。
カメラだったらピントの浅いものはいい写真に見えるけど、
ピントが深くても同じように意図を押し出せないと上手くならないわけで。
これが不足するとこれがいい。で終わって、何故いいのか理解しないから、
次に手を出した時に路頭に迷う。
日常に加えて何か効果的なトレーニング方法がないか
という、楽をしたいくそみたいな根性が首をもたげているわけだけど、
割と真面目になんかないもんかね。
こういうのって文書しかり、芸術しかり、表現全般に言えるんだよな。
あ。誕生日は無事（何事もなく）終わりました。はい。
そんな感じの生存報告。
機材側の接点は1ヶ所にした方がいいみたいな結果になったので、
それで電源側にも仮想アースつくって入れたんですが、
威力が凄いです。
定位がきっちり来ます。
一番はこれなんですが、高音低音かなり改善して良かったです。
拍手とかの立ち上がりがいいので薄っぺらい音になってないので
ひとまず最低ライン達成したかなー。
このあとはケーブル変えていかないと無理かなと。
それにしても、１ｋ程度の出費でこんだけ効果あると本当に
市販品の価格に驚くしかないなぁ。今１００円均一の
お茶入れる水筒みたいなのに入れてるんですが、
多分端子式に変更して閉じてしまうのが一番楽なんだろうなとは思いながら結局直で接続。
とりあえずゆっくり進めていこうかなー。って所ですね。
TAKET外したけどまたつけたりしてみようかなー。
それで電源側にも仮想アースつくって入れたんですが、
威力が凄いです。
定位がきっちり来ます。
一番はこれなんですが、高音低音かなり改善して良かったです。
拍手とかの立ち上がりがいいので薄っぺらい音になってないので
ひとまず最低ライン達成したかなー。
このあとはケーブル変えていかないと無理かなと。
それにしても、１ｋ程度の出費でこんだけ効果あると本当に
市販品の価格に驚くしかないなぁ。今１００円均一の
お茶入れる水筒みたいなのに入れてるんですが、
多分端子式に変更して閉じてしまうのが一番楽なんだろうなとは思いながら結局直で接続。
とりあえずゆっくり進めていこうかなー。って所ですね。
TAKET外したけどまたつけたりしてみようかなー。
かなり音量差がってピーキーさがかなりなくなります。
というか付属がスイッチングだったためにかなり音がなまってたので、
比較する価値がないというか。正直電源からの電気を信号によって
出力を作り出すアンプの機能上、電源＝音なので、電源の質が変われば
同じ機材でも別物みたいな音に鳴るんですよね。
電源回路前までの電源のノイズレベルももろに影響してくる点は謎ですが。
日本の2端子タイプでそんな差が出るもんなのかねと思って、
どう説明出来るのか知りたいところ。
話は戻って。
仕様の上ではコスパが非常に高いので買ってみたンですが、悪くないです。
この方向性だとベース電源部分にノイズ乗せないためにもアダプタ分は
全体をトランス化してしまうという手もありかなと。
直流対策もしてみたいんだけど、選択肢はKOJOくらいしかないかな？
おそらくタップだとPRO400は将来的に導入するだろうなと思うんだけど、
実際どこに使うかって言われると既にデジタル用電源タップは有るから、
実はそんなに急がなくてそのまま流れていきそうな予感。
チーターアースはほぼ購入確定かな。集合住宅の仮想アースは予想以上に効果がある。
色々やりたい事があるけど出来てない的な。
ファインメットも試せてないし、先は長いなぁ。
というか付属がスイッチングだったためにかなり音がなまってたので、
比較する価値がないというか。正直電源からの電気を信号によって
出力を作り出すアンプの機能上、電源＝音なので、電源の質が変われば
同じ機材でも別物みたいな音に鳴るんですよね。
電源回路前までの電源のノイズレベルももろに影響してくる点は謎ですが。
日本の2端子タイプでそんな差が出るもんなのかねと思って、
どう説明出来るのか知りたいところ。
話は戻って。
仕様の上ではコスパが非常に高いので買ってみたンですが、悪くないです。
この方向性だとベース電源部分にノイズ乗せないためにもアダプタ分は
全体をトランス化してしまうという手もありかなと。
直流対策もしてみたいんだけど、選択肢はKOJOくらいしかないかな？
おそらくタップだとPRO400は将来的に導入するだろうなと思うんだけど、
実際どこに使うかって言われると既にデジタル用電源タップは有るから、
実はそんなに急がなくてそのまま流れていきそうな予感。
チーターアースはほぼ購入確定かな。集合住宅の仮想アースは予想以上に効果がある。
色々やりたい事があるけど出来てない的な。
ファインメットも試せてないし、先は長いなぁ。