VB6 VBScriptでArraylist

仕事柄未だにVB6を保守することがあるのだが、For eachが使える可変長配列が欲しかったのでVBScript用に作っていたArraylistを移植してみた。「class ArrayList~end class」で囲めばVBScriptでそのまま動く。

ファイル名 Arraylist.cls

Option Explicit
    
    Private m_Item()
    Private m_count

    '末尾にItemを追加
    Public Sub Add(x)
        ReDim Preserve m_Item(m_count)
        If IsObject(x) Then
            Set m_Item(m_count) = x
        Else
            m_Item(m_count) = x
        End If
        m_count = m_count + 1
    End Sub

    'I番目の内容をxで書き換え
    Public Sub Change(I, x)
        If IsObject(x) Then
            Set m_Item(I) = x
        Else
            m_Item(I) = x
        End If
    End Sub

    '総数を返す
    Public Function count()
        count = m_count
    End Function

    '全消去
    Public Function Clear()
        m_count = 0
        Erase m_Item
    End Function

    'For each 用 例 yがArrayListなら For each x in y.item
    Public Function Item()
        Item = m_Item
    End Function

    'n番目のItemを返す
    Public Function Items(n)
        If IsObject(m_Item(n)) Then
            Set Items = m_Item(n)
        Else
            Items = m_Item(n)
        End If
    End Function
    
    'n番目のItemを削除
    Public Sub RemoveAt(n)
        If m_count >= n Then
            Dim I
            For I = n To m_count - 1 - 1
                Call Change(I, Items(I + 1))
            Next I
            m_count = m_count - 1
            ReDim Preserve m_Item(m_count)
        Else
            MsgBox ("引数が範囲外")
        End If
    End Sub

    '引数と同じItemを全て削除
    Public Sub Remove(itm)
        Dim I
        For I = m_count - 1 To 0 Step -1
            If Items(I) = itm Then
                RemoveAt (I)
            End If
        Next I
    End Sub
    
    'ソート
    Public Function Sort()
            
        If m_count = 0 Then
            Exit Function
        End If
            
        Dim I, J, swap
        For I = 0 To m_count - 1
            For J = I To m_count - 1 - 1
                If m_Item(J) > m_Item(J + 1) Then
                    swap = m_Item(J)
                    m_Item(J) = m_Item(J + 1)
                    m_Item(J + 1) = swap
                End If
            Next J
        Next I
    
    End Function

使用例

Private Sub Command1_Click()

    Dim m As New Arraylist

    m.Add (34)
    m.Add (3)
    m.Add (11)
    m.Add (28)
    m.Add (17)
    m.Add (11)
    
    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next
    
   m.Remove (11)
   MsgBox (m.count)
   
    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next
   
   
   
    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next

    m.Sort

    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next


End Sub

コンサータ36mgに増量

明日からコンサータ18mg二錠の36mgになる。

ストラテラ80mgからコンサータ18mgに切り替えた時は全く効かなくてミス連発になった。

元々コンサータ18mgは副作用の有無を調べるのが目的で余り効かないらしい。

コンサータ27mgで薬が効いている感じがしてきた。36mgでどんな効果がでるか楽しみ。

後、自立支援の正式な書類が届いた。ストラテラコンサータもとても高い薬なので助かっています。

 

以前薬局でストラテラの数を間違えて処方されたのでしっかり数を確認して受け取った。第一種向精神薬コンサータで数間違いがあったらシャレにならないから。

コンサータ27mgへ増量

5/26にストラテラ80mgからコンサータ18mgに切り替えた。 特に副作用などは無かったが、効果もあまり感じられなかった。 周りからもミスを指摘される事が有った。 ストラテラを飲んでいた時の感情がフラットになる感じは無くなった。 約1月弱経過した6/10にコンサータ27mgに切り替えたが、医者はストラテラ80mgからコンサータ18mgにいきなり切り替えるのではなくて、途中ストラテラ併用した方が良かったかも知れないと言っていた。 確かにコンサータ18mgで効果を感じる人は少なくてあくまで副作用などの確認が目的らしい。 コンサータ27mgで数日経過したが、少し効いているような気がする。 ただ、最近不眠なのと食欲が出て体重増加なのと、切れた時の疲労感がすごい。頭がボーっとなって睡魔に襲われる。

共有サーバーのEXCELファイルを開いた時と閉じた時にPC名とIPアドレスを保存するVBAマクロ

共有サーバーのEXCELファイルを開いたまま帰った人がいて困ったことがあったので作ってみた。
EXCELの標準モジュールにそのまま張り付ければ使えると思う。

Option Explicit
'*****************************************************************************
' EXCELファイルを誰が開いているか記録するマクロ
' 
' 【機能】EXCELファイルと同じフォルダにファイル名の拡張子を「.log」にしたファイル
'     にEXCELファイルを開いた時と閉じた時の日時、IPアドレス、PC名、読込専用かを
'        記録する
'
' 日付       Ver   氏名 コメント
' 2017/05/23 1.00       新規リリース
' 
'*****************************************************************************
Sub Auto_Open()

    Dim f As Integer
    
    f = FreeFile
    Open ActiveWorkbook.Path & "\" & getLogFilename For Append As #f
        Print #1, Date & "," & Time & ",[OPEN" & checkReadOnly & "]," & GetIPAddress & "," & Environ("COMPUTERNAME")
    Close #f

End Sub

Function checkReadOnly() As String

    Dim mode As String
    
    If ThisWorkbook.ReadOnly = True Then
        mode = "(読み取り専用)"
    Else
        mode = ""
    End If

    checkReadOnly = mode

End Function

Sub auto_Close()

    Dim f As Integer
    
    f = FreeFile

    Open ActiveWorkbook.Path & "\" & getLogFilename For Append As #f
        Print #1, Date & "," & Time & ",[CLOSE" & checkReadOnly & "]," & GetIPAddress & "," & Environ("COMPUTERNAME")
    Close #f

End Sub

Function getLogFilename() As String

    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    getLogFilename = FSO.GetBaseName(ThisWorkbook.Name) & ".log"
    Set FSO = Nothing

End Function


'*****************************************************************************
' IP アドレス取得
'   WMI を用いて IP アドレスを取得する。
'*****************************************************************************
Function GetIPAddress() As String

    Dim NetAdapters, objNic, strIPAddress
    Set NetAdapters = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") _
                           .ExecQuery("Select * from Win32_NetworkAdapterConfiguration " & _
                           "Where (IPEnabled = TRUE)")

    For Each objNic In NetAdapters 'ネットワークアダプターは、複数ある場合がある
        For Each strIPAddress In objNic.IPAddress 'IPは、複数割り当てられている場合がある
            GetIPAddress = strIPAddress
            Exit For        ' 1回のみ
        Next
        Exit For        ' 1回のみ
    Next

End Function

大人のADHD 今日からコンサータ

昨日病院に行って2.5ヵ月飲んだストラテラ 80mgからコンサータ18mgに変わった。 まだ飲んだばかりなので効果は分からない。 自立支援も始めた。

大人のADHDで処方されたストラテラ2ヵ月目

今朝からストラテラの朝飲む量が40mgから80mg(40mg錠2個)になった。 40mgを飲んで2ヶ月経つが、効果として 1.人の話を聞きやすくなった 2.人に話しやすくなった。 3.数字を少し覚えれるようになった。 がある。

これまで、人と話していても「〇〇については前提条件を確認しないとどちらか回答できないし」など言いたいことがあるのだが、まとめきれず回答できなかったのが、相手のいうことが理解できるし、それぞれの条件について質問・回答できるようになった。 脳内のワークメモリが増えた感じがする。 数字についてもこれまでは意識が別のことに移るとまるっきり記憶から消えていたのが、少し残るようになった。そのため簡単なミスが減ったように思う。

初日は副作用(動悸、冷や汗、吐き気)があったが、そのうち出なくなった。大体7:30に飲んで、10時くらいに副作用が出てきていた。 飛行機に乗った時に酔ったことがあったが、その後乗っても大丈夫になった。 今日から分量が80mgと2倍になったが、ちょっと冷や汗が気になるくらい。効果があるかどうかはまだわからない。

興味のないことで集中力が落ちたり、やりたくないことを先延ばしするのは相変わらずだ。これにはコンサータが聞くのかも知れない。医師の話では別な薬(たぶんコンサータ)もあるが、できるだけ最初はストラテラで効果がでるかやってみますとのことだった。

自分を表す字

土曜日にコミュニケーションセミナーを受けた。

自分を表す字「敬・情・創・学・優」 他人が選んだ字「敬・謙・志・望・率・結」

この中から5つ選ぶ 「敬・志・率・創・結」