Bonjour Serviceをアンインストールする。

1.Bonjour Serviceを停止する。

    コントロールパネル→管理ツール→サービスより、Bonjour Serviceを探して、プロパティからサービスを停止する。
    ※表示名が意味の無い文字列になっているため、サービス名で確認する。

    サービス名:Bonjour Service
    スタートアップの種類→手動
    サービスの状態→停止

2.Bonjour Serviceをサービスから削除する。

    管理者権限でコマンドプロンプトをオープンし、以下のコマンドを実行する。

    > "C:\Program Files\Bonjour\mDNSResponder.exe" -remove

    > cd "C:\Program Files\Bonjour"
    > rename mdnsNSP.dll mdnsNSP.old

3.PCを再起動し、"C:\Program Files\Bonjour"フォルダを削除する。

以上

今日は休日(文化の日)。
昨日上げたものの逆変換も欲しいよね、ということでもう一個。
まあ、リスト形式の方が便利なので、セルを空白にするよりフォントの色を目立たなくした方が良いかも。

Sub ClearLowerCell()
    '
    ' 選択範囲のセルについて、同じ列のセルに同じ値が連続している場合、一番上の値を残して下位の値をクリアする。
    ' ただし、セルの参照は選択範囲内までとする。
    ' また、クリア対象のセルの左側に値の境界がある場合、値のクリアはそこまでとする。
    ' ただし、値の境界のチェックは選択範囲までとする。
    '
    ' 2010/11/03 black-hole: 新規作成。
    '
    Dim lastCellColumn As Long
    Dim startRow As Long
    Dim startColumn As Long
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim iRow As Long
    Dim iColumn As Long
    Dim jRow As Long
    Dim jColumn As Long
    Dim strTop As String
    Dim str As String
 
    '
    ' 選択範囲を取得
    '
    startRow = Selection.Rows(1).Row
    startColumn = Selection.Columns(1).Column
    lastRow = Selection.Rows(Selection.Rows.Count).Row
    lastColumn = Selection.Columns(Selection.Columns.Count).Column
 
    '
    ' 実際の処理範囲は値が存在するセルまで
    '
    lastCellRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    lastCellColumn = Cells.SpecialCells(xlCellTypeLastCell).Column
 
    If lastRow > lastCellRow Then
        lastRow = lastCellRow
    End If
    If lastColumn > lastCellColumn Then
        lastColumn = lastCellColumn
    End If
 
    '
    ' 選択範囲を左列→右列、上行→下行の順に処理
    '
    For iColumn = startColumn To lastColumn
 
        iRow = startRow
        Do While iRow < lastRow
            strTop = Cells(iRow, iColumn).Value
 
            '
            ' 下方向に次の値を検索
            '
            For jRow = iRow + 1 To lastRow
 
                '
                ' 次の値を検出したら検索終了
                '
                str = Cells(jRow, iColumn).Value
                If str <> "" Then
                    If StrComp(str, strTop, vbBinaryCompare) <> 0 Then
                        Exit For
                    End If
                End If
 
                '
                ' 左側のセルに値の境界を検出したら検索終了
                '
                jColumn = startColumn
                Do While jColumn < iColumn
                    str = Cells(jRow, jColumn).Value
                    If str <> "" Then
                        If StrComp(str, Cells(iRow, jColumn).Value, vbBinaryCompare) <> 0 Then
                            Exit For ' For jRowを終了
                        End If
                    End If
                    jColumn = jColumn + 1
                Loop
            Next
 
            '
            ' セルの値をクリア
            '
            If jRow > iRow + 1 Then
                If strTop <> "" Then
'                    Range(Cells(iRow + 1, iColumn), Cells(jRow - 1, iColumn)).Interior.ColorIndex = 6 ' テスト用
'                    Range(Cells(iRow + 1, iColumn), Cells(jRow - 1, iColumn)).Font.ColorIndex = 15
                    Range(Cells(iRow + 1, iColumn), Cells(jRow - 1, iColumn)).Value = ""
                End If
            End If
 
            iRow = jRow
        Loop
    Next
End Sub

以上

とりあえず、表題の通り。
ただし、空白セルに上位セルの値をコピーするだけなら、空白セルを全選択して上位セルへの参照を一括入力するだけで良いので、ひと工夫してみた。
誰かの作った階層形式の表をリスト形式(データベース形式)に変換したいときなどにどうぞ。

Sub CopyHigherToBlankCell()
    '
    ' 選択範囲のセルについて、セルの値が空白の場合、上位のセルの値をコピーする。
    ' ただし、上位セルの参照は選択範囲までとする。
    ' また、コピー対象のセルの左側に値の境界がある場合、値のコピーはそこまでとする。
    ' ただし、値の境界のチェックは選択範囲までとする。
    '
    ' 2010/11/02 black-hole: 新規作成。
    ' 2010/11/03 black-hole: 一寸修正。
    '
    Dim lastCellRow As Long
    Dim lastCellColumn As Long
    Dim startRow As Long
    Dim startColumn As Long
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim iRow As Long
    Dim iColumn As Long
    Dim jRow As Long
    Dim jColumn As Long
    Dim str As String
 
    '
    ' 選択範囲を取得
    '
    startRow = Selection.Rows(1).Row
    startColumn = Selection.Columns(1).Column
    lastRow = Selection.Rows(Selection.Rows.Count).Row
    lastColumn = Selection.Columns(Selection.Columns.Count).Column
 
    '
    ' 実際の処理範囲は値が存在するセルまで
    '
    lastCellRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    lastCellColumn = Cells.SpecialCells(xlCellTypeLastCell).Column
 
    If lastRow > lastCellRow Then
        lastRow = lastCellRow
    End If
    If lastColumn > lastCellColumn Then
        lastColumn = lastCellColumn
    End If
 
    '
    ' 選択範囲を左列→右列、上行→下行の順に処理
    '
    For iColumn = startColumn To lastColumn
 
        iRow = startRow
        Do While iRow < lastRow
 
            '
            ' 下方向に次の値を検索
            '
            For jRow = iRow + 1 To lastRow
 
                '
                ' 次の値を検出したら検索終了
                '
                If Cells(jRow, iColumn).Value <> "" Then
                    Exit For
                End If
 
                '
                ' 左側のセルに値の境界を検出したら検索終了
                '
                jColumn = startColumn
                Do While jColumn < iColumn
                    str = Cells(jRow, jColumn).Value
                    If str <> "" Then
                        If StrComp(str, Cells(iRow, jColumn).Value, vbBinaryCompare) <> 0 Then
                            Exit For ' For jRowを終了
                        End If
                    End If
                    jColumn = jColumn + 1
                Loop
            Next
 
            '
            ' 空白セルに上位セルの値をコピー
            '
            If jRow > iRow + 1 Then
                str = Cells(iRow, iColumn).Value
                If str <> "" Then
'                    Range(Cells(iRow + 1, iColumn), Cells(jRow - 1, iColumn)).Interior.ColorIndex = 6 ' テスト用
                    Range(Cells(iRow + 1, iColumn), Cells(jRow - 1, iColumn)).Value = str
                End If
            End If
 
            iRow = jRow
        Loop
    Next
End Sub

以上

とりあえず表題の通り。

1.以下のURLからInstant ClientのODACパッケージをダウンロードする。

    http://www.oracle.com/technology/global/jp/software/tech/oci/instantclient/index.html
    http://www.oracle.com/technology/global/jp/software/tech/oci/instantclient/htdocs/winsoft.html

    Version 11.1.0.6.0
        Instant Client Package - ODAC
            ODAC1110621Xcopy.zip (45,461,502 bytes)

        ※Instant Clientも含まれているのでこれだけダウンロードすれば良い。

2.ダウンロードしたファイルを適当なフォルダに展開する。

3.展開したフォルダに移動し、以下のコマンドを実行する。

    > install.bat oo4o c:\oracle myhome true

    ※OO4Oを使用するだけなら環境変数の設定などは不要。

4.VBの[ツール]メニューの[参照設定]に以下のライブラリが追加されていればOK。

    Oracle InProc Server 5.0 Type Library

Webページの指定したコントロールが有効になるまで待つ。
リトライ回数×待ち時間を超えた場合はエラー。

function waitctrl($browser, $url, $ctrlId, $retryMax, $waitTime) {

        if ( $url -ne $null ) {
                Write-host "Loading $url..."
                $browser.navigate($url)
        }

        $retry = 1

        while ($retry -le $retryMax) {

                Write-host "Waiting for page to load... $retry."

                [System.Threading.Thread]::Sleep($waitTime)

                $doc = $browser.document
                if ($doc -ne $null) {

                        $ctrl = $doc.getElementByID($ctrlId)
                        if ($ctrl -ne $null) {
                                return $true
                        }
                }

                $retry++
        }

        Write-host "Can't load page."

        return $false
}

#
# 使用例
#
$url = # Webページ
$idSaveBottom = # セーブボタンのコントロールId
$ie = new-object -comObject "InternetExplorer.Application"
$ie.visible = $true

# セーブボタンが有効になるまで待つ。
waitctrl $ie $url $idSaveBottom 5 10
if ( -not $? ) {
        # エラー処理
}

# ポチッとな。
$doc = $ie.document
$save = $doc.getElementById($idSaveBottom)
$save.click()

Internet Explorer 7以前では、レジストリの変更が必要。
Internet Explorer 8では、[ツール]-[開発者ツール] の[ファイル]-[Internet Explorer ソースの表示のカスタマイズ] から変更可能。

レジストリの変更例

-- IE View Souce Editor.reg --
Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\View Source Editor\Editor Name]
@="C:\\Program Files\\TeraPad\\TeraPad_html.cmd"

TeraPadにオプションを指定して起動

-- TeraPad_html.cmd --
start %~d0"%~p0\TeraPad.exe" /html /wb=-1 %1

DOS窓が一瞬開くのはご愛敬。

説明は省略。

Function EncodeURI(uri As String) As String
        Set sc = CreateObject("ScriptControl")
        sc.Language = "JScript"
        Set js = sc.CodeObject
        EncodeURI = js.encodeURIComponent(uri)
End Function

Function DecodeURI(uri As String) As String
        Set sc = CreateObject("ScriptControl")
        sc.Language = "JScript"
        Set js = sc.CodeObject
        DecodeURI = js.decodeURIComponent(uri)
End Function

ちなみに、encodeURI()/decodeURI()ってのもあるでよ。

とりあえず、表題の通り。
使い方の異なる Functionプロシージャーと Subプロシージャーの二つを作成。
詳細はコードのコメントを参照。

Function ToHankaku(ByVal src As String) As String
    '
    ' 文字列中の半角変換可能な文字を半角に変換する。
    ' ただし、半角片仮名文字(0xA1-0xCF)は全角に変換する。
    ' このとき、可能であれば半角・全角片仮名文字と直後の濁点・半濁点が合成される。
    '
    ' 2009/12/17 black-hole: 新規作成
    '
    '
    Dim re As Object
    Dim Match As Object
 
    '
    ' 正規表現オブジェクトを作成
    '
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "[｡-ﾟ]+"   ' 1文字以上の半角片仮名
    re.Global = True        ' 検索範囲はグローバル
 
    '
    ' 半角変換可能な文字を全て半角に変換
    ' 全角片仮名文字もいったん半角片仮名に変換される。
    '
    src = StrConv(src, vbNarrow)
 
    '
    ' 1文字以上の半角カナを検索し全角に変換
    ' 半角片仮名文字の直後に濁点・半濁点があればここで合成される。
    '
    For Each Match In re.Execute(src)
        src = Replace(src, Match, StrConv(Match, vbWide), , 1)
    Next
 
    ToHankaku = src  ' 返り値
 
End Function

Sub SelToHankaku()
    '
    ' 選択されたセル範囲について、文字列中の半角変換可能な文字を半角に変換する。
    ' ただし、半角片仮名文字(0xA1-0xCF)は全角に変換する。
    ' このとき、可能であれば半角・全角片仮名文字と直後の濁点・半濁点が合成される。
    '
    ' 2009/12/17 black-hole: 新規作成
    '
    '
    Dim re As Object
    Dim Cell As Range
    Dim Match As Object
    Dim Str As String
 
    '
    ' 正規表現オブジェクトを作成
    '
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "[｡-ﾟ]+"   ' 1文字以上の半角片仮名
    re.Global = True        ' 検索範囲はグローバル
 
    '
    ' 選択されたセル範囲について、以下の処理を実行
    '
    For Each Cell In Selection
 
        Str = Cell.Value
        If Str <> "" Then
 
            '
            ' 半角変換可能な文字を全て半角に変換
            ' 全角片仮名文字もいったん半角片仮名に変換される。
            '
            Str = StrConv(Str, vbNarrow)
 
            '
            ' 1文字以上の半角カナを検索し全角に変換
            ' 半角片仮名文字の直後に濁点・半濁点があればここで合成される。
            '
            For Each Match In re.Execute(Str)
                Str = Replace(Str, Match, StrConv(Match, vbWide), , 1)
            Next
            Cell.Value = Str
 
        End If
 
    Next
 
End Sub

以上

-- 2010/09/25 題名とトピックを修正 --

CSVファイルをExcelで開くとき、数字のみのデータは数値として
取り込まれるため、"0012"のように先頭に"0"が付いた文字列は自動的に
数値に変換され、先頭の"0"が削除されてしまう。

というわけで、いろいろ調査(中略)

(´・ω・｀)

0001,0002,0003,0004             → |     1|     2|     3|     4|
"0001","0002","0003","0004"     → |     1|     2|     3|     4|
'0001,'0002,'0003,'0004         → |'0001 |'0002 |'0003 |'0004 |

＼(＾o＾)／

="0001",="0002",="0003",="0004" → |0001  |0002  |0003  |0004  |

以上

-- 2009/12/17 追記 --

どうやらタブでもOKらしい。

\t0001,\t0002,\t0003,\t0004 → |0001  |0002  |0003  |0004  |

"\t"はタブ文字を表す。オープン後、タブ文字は削除される。

以上

とりあえず、またひさしぶりの覚え書き。

Windows XPで、HDD、および、USBメモリのドライブレターを変更するには、「コントロールパネル」→「管理ツール」→「コンピュータの管理」→「ディスクの管理」で対象ディスクを選択し、右クリックメニューの「ドライブ文字とパスの変更」で変更することができる。
しかし、SDカードの場合、「ディスクの管理」に対象ディスクが表示されないため、この方法ではドライブレターを変更することができない。

Windows XPで、SDカードのドライブレターを変更するには、以下の手順を行う。

(1)SDカードをパソコンに挿入する。

　→D:などの適当なドライブレターが割り当てられる。

(2)レジストリエディタ(regedit)を起動し、次のキーを選択する。

　HKEY_LOCAL_MACHINE\SYSTEM\MountedDevices

　選択したキーの配下には、次のようなキーが存在する。

    \DosDevices\C:
    \DosDevices\D:
    \DosDevices\E:

(3)キーの名前の右端がドライブレター、値が対応するディスクの固有値となっているので、SDカードに対応するキーを探して、右クリックメニューの「名前の変更」でドライブレターの部分を変更する。

    例、ドライブレターを D:からS:に変更する。

        \DosDevices\D: → \DosDevices\S:

(4)SDカードをいったん取り出し、再度挿入する。

以上