« 2011年3月 | トップページ | 2011年5月 »

2011年4月

2011年4月30日 (土)

HTMLファイルの目次を作る2

前の記事はこちら
HTMLファイルの目次を作る

今回はファイル名をリンクに表示するのではなく
HTMLファイル内のタイトルをリンクに表示したいと思います。

タイトルとは<TITLE>と</TITLE>で囲まれた間の文字です。

もしタイトルがなければ
ファイル名をリンクの文字にします。

あと更新日時も付け加えます。
これについてはこちらの記事も参照してください。
画像一覧のHTMLファイル作成

タイトルを取得するために
HTMLファイルをテキストファイルとして開きます。
そのファイルの文字列から「<TITLE>」と「</TITLE>」が
何文字目かを調べます。
これにはInstr関数を使用します。

たとえば「<TITLE>」と「</TITLE>」がそれぞれ
15文字目と37文字目だったとします。
そしてタイトルが次のようだとします。

<TITLE>画像一覧のHTMLファイルを作成</TITLE>

一番最初の<が15文字目、
終了タグの<が37文字目です。

「画像一覧のHTMLファイルを作成」だけを
ファイルの文字列から取り出すには、
ファイルの文字列の(15+7)番目の文字列から
(37-15-7)文字数だけ取り出せばいいです。

これにMid関数を使います。

変数MyPathに
HTMLファイルの目次を生成したいフォルダを入れてください。

コードはこちら

HTMLファイルの目次を作る2のコード:

Sub macro110430a()
    Dim MyPath As String, MyFile As String
    Dim MyHTML As String
    Dim i As Integer
    Dim fs, f As Object
    Dim dlm As Date '.DateLastModified
    Dim ftext As String, ftext2 As String
    'ファイル全文文字列、その大文字化
    Dim num1 As Long, num2 As Long
    'タイトル開始、終了文字番目
    Dim strTitle As String 'タイトル文字列
   
    MyHTML = "<HTML><HEAD><STYLE type='text/css'>" _
        & "SPAN.dlm{font-size:smaller}</STYLE>" _
        & "</HEAD><BODY>"
   
    'フォルダを指定する
    MyPath = "フォルダへのパス\"
   
    'ファイルの有無を確認
    With Application.FileSearch
        .NewSearch
        .LookIn = MyPath
        '
        .Filename = "*.htm*"
        If .Execute() > 0 Then
            MsgBox .FoundFiles.Count & _
                " 個のファイルが見つかりました。"
               
            Set fs = CreateObject("Scripting.FileSystemObject")
            For i = 1 To .FoundFiles.Count
            
                '最終更新日取得
                Set f = fs.GetFile(.FoundFiles(i))
                dlm = f.DateLastModified
               
                'タイトル等取得
                Set f = fs.OpenTextFile(.FoundFiles(i), 1, False, -2)
                ftext = f.readall
                ftext2 = UCase(ftext)
                num1 = InStr(ftext2, "<TITLE>")
                num2 = InStr(ftext2, "</TITLE>")
                If num1 <> 0 Then
                    'タイトルがある
                    strTitle = Mid(ftext, num1 + 7, num2 - num1 - 7)
                Else
                    'タイトルがない
                    'ファイル名にする
                    strTitle = Dir(.FoundFiles(i))
                End If
                f.Close
               
                MyHTML = MyHTML _
                    & "<A target=" & Chr(34) & "main" & Chr(34) _
                    & " href =" & Chr(34) _
                    & Dir(.FoundFiles(i)) & Chr(34) & ">" _
                    & strTitle & "</A> <SPAN class=dlm>" _
                    & "(" & Format(dlm, "yyyy/mm/dd hh:ss") & ")" _
                    & "</SPAN><BR/>" & Chr(10)
               
            Next i
        Else
            MsgBox "検索条件を満たすファイルはありません。"
        End If
    End With
    MyHTML = MyHTML & "</BODY></HTML>"
   
    'HTML形式のファイルを生成
    Dim a As Object
   
    Set a = fs.CreateTextFile(MyPath & "menu110430.html", True)
    a.WriteLine (MyHTML)
    a.Close
   
    'フレームのHTML生成
    MyHTML = "<HTML><FRAMESET cols='70%,30%'>" & _
        "<FRAME name='main' src='menu110430.html'>" & _
        "<FRAME name='menu' src='menu110430.html'>" & _
        "</FRAMESET></HTML>"
    Set a = fs.CreateTextFile(MyPath & "frame110430.html", True)
    a.WriteLine (MyHTML)
    a.Close
   
End Sub

frame110430.htmlを開いたときに
文字化けしているリンクの文字があるときは
リンク先のファイルを
ANSIかunicodeで上書き保存してください。

それから
frame110430.htmlとmenu110430.htmlを削除してから
再度実行してみてください。

| | コメント (0) | トラックバック (0)

2011年4月24日 (日)

VBAのコードをHTMLで表示できるようにする

VBAのコードをHTMLでそのままの形式で表示するには
改行や段落などのタグを追加したり、
インデントを正しく表示するために
スペースの特殊フォントを入れたりします。

またVBAのコード内の文字列にHTMLが入っていると
ブラウザはそれをタグとみなしてしまうので
それも特殊フォントに置き換えます。

手順を説明します。

1.まずVBAコード内の文字列に含まれる
タグとして認識されてしまう記号&<>"を
特殊文字に置き換えます。

2.次に見やすくするために
1行空けているところに<P>タグを使用します。
「1行空けている」ということは改行が2つ続いているので
「Chr(10) & Chr(10)」を「</P><P>」で置き換えます。

3.改行のところに<BR/>タグを追加します。
つまり、「Chr(10)」を「<BR/>」に置き換えます。

4.インデントを正しく表示するために
スペース2つを「&nbsp; 」で置き換えます。
タブキー一回はスペース2つ分みたいです。

コードはこちら

VBAのコードをHTMLで表示できるようにするコード:

Sub macro110424a()
'マクロソースのHTML変換
'HTML変換したいコードをB1セルに入れておく

    Dim Str As String
    Dim i As Long
   
    Str = Range("B1")
   
    '1.特殊フォント置換え
    Str = Replace(Str, "&", "&amp;")
    Str = Replace(Str, "<", "&lt;")
    Str = Replace(Str, ">", "&gt;")
    Str = Replace(Str, Chr(34), "&quot;")
   
    '2.1行空け置換え
    Str = Replace(Str, Chr(10) & Chr(10), "</P><P class=macro>")
   
    '3.改行置換え
    Str = Replace(Str, Chr(10), "</BR>")
   
    '4.スペース置換え
    Str = Replace(Str, Chr(32) & Chr(32), "&nbsp; ")
   
    '変換後の文字列をB2セルに入れる
    Range("B2") = Str

End Sub

上の枠内のコードのHTMLは
これを使って生成しました。

| | コメント (0) | トラックバック (0)

2011年4月23日 (土)

画像一覧のHTMLファイル作成

以前の記事でもHTMLファイル作成したことがあります。

その記事ではあるフォルダ内の
HTMLファイルの目次を作りました。
今回は、リンクをクリックすると
画像ファイルを見られるHTMLファイルを作成します。

画像ファイルの形式についてですが
いろいろな形式があります。
ここではjpeg形式のみです。
お好みで拡張子のところ(.Filename = "*.jpg")を
変更してください。

基本的なことは以前の記事と変わりないので
説明は省きます。

ただ拡張子のところ(.Filename = "*.jpg")を
変えただけではおもしろくないので、
HTMLをフレーム付にしました。
でもまあこれはVBAというよりはHTMLの問題ですかね。

ウィンドウを左右2つのフレームに分けて
左側に画像を、右側に画像のリンクの一覧を表示します。
右側に画像のリンクをクリックすると
左側に画像が表示されようにします。

このようにフレームを使うので
frame.htmlとmenu.htmlの2つのHTMLファイルを生成します。
生成したHTMLファイルはframe.htmlの方を開いてください。

あとの変更は、
ファイルの最終更新日時を追加したことです。
下のコードの

f.DateLastModified

のところです。
これがファイルの最終更新日時のプロパティです。
Format関数を使って表示形式を変更しています。

変数MyPathに画像があるフォルダを指定してください。
HTMLファイルは指定したフォルダ内に作成されます。

コードはこちら

画像一覧のHTMLファイル作成コード:

Sub macro110423a()
'指定したフォルダ内の
'画像ファイルの目次を作る

    Dim MyPath As String, MyFile As String
    Dim MyHTML As String
    Dim i As Integer
    Dim fs, f As Object
   
    MyHTML = "<HTML><HEAD><STYLE type='text/css'>" _
        & "SPAN.dlm{font-size:smaller} </STYLE></HEAD><BODY>"
   
    'フォルダを指定 する
    MyPath = "フォルダへのパス\"
   
    'ファ イルの有無を確認
    With Application.FileSearch
        .NewSearch
        .LookIn = MyPath
        '
        .Filename = "*.jpg"
        If .Execute() > 0 Then
            MsgBox .FoundFiles.Count & _
                " 個のファイルが見つかりました 。"
               
            Set fs = CreateObject("Scripting.FileSystemObject")
            For i = 1 To .FoundFiles.Count
                Set f = fs.GetFile(.FoundFiles(i))
                MyHTML = MyHTML & "<A target=" & Chr(34) & "main" _
                    & Chr(34) & " href =" & Chr(34) _
                    & Dir(.FoundFiles (i)) & Chr(34) & ">" _
                    & Dir(.FoundFiles(i)) & "</A> <SPAN class=dlm>" _
                    & "(" _
                    & Format(f.DateLastModified, "yyyy/mm/dd hh:ss") _
                    & ")" & "</SPAN><BR/>" & Chr(10)
            Next i
        Else
            MsgBox " 検索条件を満たすファイルはありません。"
        End If
    End With
    MyHTML = MyHTML & "</BODY></HTML>"
   
    'HTML形式のファイルを生成
    Dim a As Object
   
    Set a = fs.CreateTextFile(MyPath & "menu.html", True)
    a.WriteLine (MyHTML)
    a.Close
   
    'フレームのHTML生成
    MyHTML = "<HTML><FRAMESET cols='70%,30%'>" & _
        "<FRAME name='main' src='menu.html'>" & _
        "<FRAME name='menu' src='menu.html'>" & _
        "</FRAMESET></HTML>"
    Set a = fs.CreateTextFile(MyPath & "frame.html", True)
    a.WriteLine (MyHTML)
    a.Close

End Sub

なにかいいファイルの整理方法がないですかね~
またはそういうソフトウェアなど…

いろいろな保存形式で、使用するソフトも違うファイルを
1つのフォルダにいれて、
それでいてファイルの内容を
本をパラパラめくって見るような方法がほしいです。

そういった点では
いろいろな形式のファイルを表示できるブラウザは便利ですけど
まだまだ不自由です。

| | コメント (0) | トラックバック (0)

2011年4月17日 (日)

現在のカラーパレットをセルに表示して確認する

現在のカラーパレットの
表示される色とインデックスをセルに表示して確認します。

単純にFor文を使います。

コードはこちら

現在のカラーパレットを確認するコード:

Sub macro110417a()
'カラーパレットを確認

    Sheets.Add
    Dim i As Integer
   
    Cells(1, 1) = "色"
    Cells(1, 2) = "ColorIndex"
   
    For i = 1 To 56
        Cells(i + 1, 1).Interior.ColorIndex = i
        Cells(i + 1, 2) = i
    Next i
   
End Sub

実行後のシートの一部:
Vba20110417a

単純ですが、なかなか重宝します。

| | コメント (0) | トラックバック (0)

2011年4月16日 (土)

日付か時刻かの判別2

前の記事はこちら
日付か時刻かの判別

さて前回の日付か時刻かの判別から少し進んで
24:00以上の時刻も加えて判別します。

24:00以上の時刻がIsDate関数では
Falseになることは以前の記事で言いました。
それでCDate2関数を作ったわけですが、
この関数を使って24:00以上の時刻も加えて判別します。

If文の条件分岐で
IsDate関数がFalseになってElseにいったところで
CDate2関数を使います。

CDate2関数は、
日時と24:00以上の時刻以外の値を入れると
Emptyを返します。

下のコードではIf文によって
日時以外の値のときのみ
CDate2関数を使うElseにいかないようになっています。

よって、
ここのCDate2関数が返す値がEmptyでないなら
CDate2関数にいれた値は24:00以上の時刻ということになります。

コードはこちら

日付か時刻かの判別コード2:

Sub macro110416a()
'日付と時刻の判別2
'24:00以上の時間も判別

    Dim MyValue As String
    MyValue = InputBox("日付か時刻かを判別します。")
   
    If IsDate(MyValue) Then
        If CDate(MyValue) = Int(CDate(MyValue)) Then
            MsgBox ("日付のみ")
        ElseIf CDate(MyValue) < 1 Then
            MsgBox ("時刻のみ")
        Else
            MsgBox ("日付のみ、時刻のみの値ではありません。")
        End If
    ElseIf IsEmpty(CDate2(MyValue)) = False Then
        MsgBox ("24:00以上の時刻の値です。")
    Else
        MsgBox ("日時ではありません。")
    End If
   
End Sub

実行例:
Vba20110416a

結果:
Vba20110416b

CDate2関数は過去に原因不明のエラーを起こしたことがあります。
CDate2関数でエラーになったらとりあえず、
tempシートを削除して再度実行してみてください。

| | コメント (0) | トラックバック (0)

2011年4月10日 (日)

シートを移動して並び替える2

前の記事に続いて
シートの並び替えをします。

今回は「CodeName」で並び替えます。

名前で並び替える方法と
大体は同じですが、
シートを入れ替える箇所で少し変更があります。

シートのCodeNameを配列に入れて、
その配列を並び替えるまでは同じような流れです。

CodeNameでシートを指定するために
Object型の変数を使用します。

もしCodeNameが○○なら
そのシートをObject型の変数obj1に入れる。
このように指定したシートを入れたobj1とobj2を準備します。

これを使ってシートを入れ替えるコードは
次のようになります。

obj1.Move Bofore:=obj2

このコードは
obj1に入れたシートを
obj2に入れたシートの前(左)に移動します。

以上説明した変更箇所は
次のコードのFor Eachステートメント中や直後です。
注意してみてください。

コードはこちら

シートの並び替えをするコード:

Sub macro110410a()
'シートの並び替え
'CodeName順

    Dim i As Integer
    Dim strShname() As Variant
    ReDim strShname(Sheets.Count)
   
    '配列に名前を入れる
    For i = 1 To Sheets.Count
        strShname(i) = Sheets(i).CodeName
    Next i
   
    '配列を並び替える(昇順)
    Call BubbleSort2(strShname, 0)
   
    'シートの入れ替え
    '配列の最初から順番に左からシートを並べる
    Dim obj1 As Object, obj2 As Object
    For i = 2 To Sheets.Count
        For Each sh In Sheets
            If sh.CodeName = strShname(i) Then
                Set obj1 = sh
            ElseIf sh.CodeName = strShname(i - 1) Then
                Set obj2 = sh
            End If
        Next sh
        obj1.Move before:=obj2
    Next i

End Sub

さてCodeNameでシートを並び替えると、
シートを挿入した順に並び替えられます。
ただし、シートを削除したことがないワークブックのみです。
理由は以下の通りです。

CodeNameはシートが挿入された順番に
1、2、3、4、5のように番号が振られます。
(CodeNameはSheet1、Sheet2のようになりますが番号だけに省略します。)

例えば3のシートを削除したとします。
次にシートが挿入されるとCodeNameは6になります。
ここではまだ挿入した順になっています。

さて少し前に戻って
3のシートを削除して一旦ワークブックを閉じます。
再度ワークブックを開いてからシートを挿入すると、
このシートのCodeNameは3になります。
もう一枚シートを挿入するとCodeNameは6になります。
この場合は、シートは挿入順ではなくなりました。

以上の例のように
シートを削除したことがあり、
ワークブックを閉じたことがあるワークブックは
CodeNameがシートの挿入した順番になっていない可能性が高いです。

| | コメント (0) | トラックバック (0)

2011年4月 9日 (土)

シートを移動して並び替える1

シートの位置を指定しないで
シートの挿入をVBAで実行すると
選択されているシートによって
挿入する位置が変わってしまいます。

このようにあまり計画せず
シートの挿入を繰り返して
シートが多くなってくると
見にくくなります。

そこでシートを移動して並び替えをします。

今回はシートの「名前」で並び替えをします。

シートを並び替えるメソッド、
なんてものはないでしょうから
自分で組み立てます。

大まかな流れは次のようになっています。

まずシートの名前を配列に入れる。
次にそれを並び替える。

この配列の並び替えに以前の記事で使った
FunctionプロシージャのBubbleSort2を使用します。

この並び替えた配列の通りに
シートを並び替えていきます。

シートを移動するには次のようにします。

Sheets("シート1").Move Before:=Sheets("シート2")

このコードは
シート名が「シート1」のシートを
シート名が「シート2」のシートの前(左)に移動する。
という操作を実行します。

コードはこちら

シートの並び替えをするコード:

Sub macro110409a()
'シートの並び替え
'名前順

    Dim i As Integer
    Dim strShname() As Variant
    ReDim strShname(Sheets.Count)
   
    '配列に名前を入れる
    For i = 1 To Sheets.Count
        strShname(i) = Sheets(i).Name
    Next i
   
    '配列を並び替える(昇順)
    Call BubbleSort2(strShname, 0)
   
    'シートの入れ替え
    '配列の最初から順番に右から左へシートを並べる
    For i = 2 To Sheets.Count
        Sheets(strShname(i)).Move _
            before:=Sheets(strShname(i - 1))
    Next i

End Sub

このコードを次の画像のようなワークブックで実行します。
Vba20110409a

実行後はこのようになります。
Vba20110409b

シートの名前に番号、時間、日付など入っていると
シートの名前で並び替えは便利です。

次の記事ではCodeNameでシートを移動して並び替えをします。

| | コメント (0) | トラックバック (0)

2011年4月 2日 (土)

シートの指定方法のまとめ

シートをする方法を3通り挙げます。

1.名前で指定する。
2.Indexで指定する。
3.CodeNameで指定する。

1.名前で指定する。

シートを手動で選択するときタブをクリックします。
名前というのは、
このタブに表示されている文字のことです。
コードは次のようになります。

ActiveWorkbook.Sheets("名前").Activate

2.Indexで指定する。

Indexは左端から右側のシートへ
1から順番になっています。
シートを入れ替えるとIndexも変化します。
コードは次のようになります。

ActiveWorkbook.Sheets(1).Activate

3.CodeNameで指定する。

CodeNameは名前/Nameとは違います。
VBEのウィンドウでプロジェクトを表示させると
下の画像のようにシートオブジェクトが表示されます。
Vba20110402a

矢印のところで説明します。

Sheet1(Sheet1)

このようになっています。
カッコ内が名前で、括弧の外左側がCodeNameです。
名前とCodeNameの両方がSheet1なのでわかりにくいです。

たとえばSheet1という名前を「シート1」に変更すると

Sheet1(シート1)

のように変更されます。
Vba20110402b

コードは次のようになります。

Sheet1.Activate

次のようにするとエラーになります。

Workbooks("Book2").Sheet1.Activate
ActiveWorkbook.Sheet1.Activate

大抵の場合は名前で指定すれば充分です。

Indexで指定する方法は
新しいシートを常に一番左に挿入したい場合に使えます。

Sheets.Add before:=Sheets(1)

このようにすると
Indexが1つまり一番左側のシートの前に
シートが挿入されます。

| | コメント (0) | トラックバック (0)

« 2011年3月 | トップページ | 2011年5月 »