Hatena::ブログ(Diary)

はけの徒然日記 このページをアンテナに追加 RSSフィード

2005 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2006 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 04 | 05 | 08 | 09 | 10 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 10 | 11 |
2011 | 01 | 02 | 03 | 04 | 11 | 12 |
2012 | 02 | 03 | 05 |
2014 | 02 | 03 | 04 | 05 | 12 |
2015 | 05 | 07 | 08 | 09 | 10 | 11 | 12 |
2016 | 01 | 02 | 04 | 05 | 08 |

2016-08-27(Sat)

EXCEL VBAメモ - クリップボードのアクセス

クリップボードへのアクセスは、DataObjectを介して行う。

またクリップボードが空か否か、どんなデータが入っているか確認Application.ClipboardFormatsを使用する。

' クリップボードからテキストを読み出す
Sub getTextFromClipBoard()
    Dim i As Long
    Dim buf As String

    ' クリップボードを中継するオブジェクト
    Dim CBrd As New DataObject
    ' クリップボードの状態を確認する
    Dim CBFmt As Variant: CBFmt = Application.ClipboardFormats
    Dim isText As Boolean: isText = False

    If CBFmt(1) = True Then
        MsgBox "クリップボードは空です"
        Exit Sub
    Else
'        MsgBox "UBound(CBFmt) = " & UBound(CBFmt)
'        For i = 1 To UBound(CBFmt)
'            MsgBox TypeName(CBFmt(i))
'        Next

        ' クリップボード内のデータ種別の確認
        For i = 1 To UBound(CBFmt)
            ' https://msdn.microsoft.com/ja-jp/library/office/ff839748.aspx
            If CBFmt(i) = xlClipboardFormatText Then isText = True: Exit For
        Next
        
        ' テキスト取り出し
        If isText Then
            CBrd.GetFromClipboard
            buf = CBrd.GetText
            MsgBox buf
        Else
            MsgBox "テキストではありません"
        End If
    End If

    Set CBrd = Nothing
End Sub

' クリップボードへテキストをセット
Sub putTextToClipBoard()
    Dim buf As String
    Dim CBrd As New DataObject
    
    buf = "あいうえお"
    CBrd.SetText buf
    CBrd.PutInClipboard
    
    Set CBrd = Nothing
End Sub

2016-08-12(Fri)

EXCEL VBAメモ - バイナリファイルアクセス

LOFでファイルサイズを取得できる。Get,Put共、第2引数位置指定、第3引数サイズ分だけ読み書きを行う。

読み取り時bufの不足分は0で埋められる。

Sub accessBinFile()
    Dim fNo As Long
    Dim fName As String
    Dim buf(0 To 4) As Byte
    Dim pos As Long, i As Long
    Dim s As String
    
    fNo = FreeFile
    fName = ThisWorkbook.Path & "\sample.txt"
    
    ' Textで元データ書き込み
    Open fName For Output As #fNo
    Print #fNo, "0123"
    Print #fNo, "ABCD"
    Close #fNo
    
    ' Binaryで読み込み
    pos = 1
    Open fName For Binary As #fNo
    Do Until pos > LOF(fNo)  ' #は不要
        Get #fNo, pos, buf
        s = ""
        For i = 0 To UBound(buf)
            s = s & Right("0" & Hex(buf(i)), 2) & " "
        Next
        MsgBox s
        pos = pos + UBound(buf) + 1
    Loop
    Close #fNo
    
    ' 2Byte目を"9"に書き換え
    Open fName For Binary As #fNo
    Put #fNo, 2, CByte(Asc("9"))
    Close #fNo
End Sub

EXCEL VBAメモ - テキストファイルアクセス

ファイルハンドル?は、#1などと番号を指定しても良いが、FreeFileで空いている番号を取得することもできる。

Sub accessTextFile()
    Dim fNo As Long
    Dim fName As String
    Dim s As String
    
    fNo = FreeFile
    fName = ThisWorkbook.Path & "\sample.txt"
    
    ' 1行ずつ書き込み
    Open fName For Output As #fNo ' 追加の場合はAppend
    Print #fNo, "1行目"
    Print #fNo, "2行目"
    Close #fNo
    
    ' 1行ずつ読み込み
    Open fName For Input As #fNo
    Do Until EOF(fNo) ' #は不要
        Line Input #fNo, s ' 1行読み取り
        MsgBox s
    Loop
    Close #fNo
End Sub

2016-08-10(Wed)

Windows10 Anniversary Update

お盆休みに入ったので、バージョン1607を適用しました。動作は特に問題なし。

8月の月例updateにリストがでなかったので、「更新とセキュリティ」の詳細情報から更新実施しました。

心持ち、ブラウザの動作が速くなったような……気のせい?


メモ