============================================================================
【 ソフト名 】  画像を見る・音楽を聞く・ファイルを録る　見聞録2000  Ver1.21
【最終更新日】  2001/10/26
【 作 成 者 】  遠山 文雄 (sweep@po.twin.ne.jp)
【ファイル名】  knbn2000.exe
【ｿﾌﾄｳｪｱ種別】  フリーウェア
【動作確認OS】  Windows Me
【 動作確認 】  Dell Dimension XPS D300
【  転  載  】  自由です
【 別途必要 】  Excel2000以上
【 ﾎｰﾑﾍﾟｰｼﾞ 】  http://www.twin.ne.jp/~sweep/
============================================================================


◎ はじめに
　1999/1月号の日経ソフトウエアに私が紹介されまして、その時の記者さんから
、「画像を扱うプログラムを80行以内のコードで作成してほしい」と依頼をうけ、
挑戦しました。それ以来、機能を増やし続け現在の「見聞録2000」に至っています。

その時のコードを以下に載せてみます。当時Excel2000は未だ発売されてなかったと
記憶しています、Excel97で作成しました

下準備として、
■ユーザーフォームにリストボックス(オブジェクト名:ファイルリスト)・
　コマンドボタン(オブジェクト名:おわるButton)を張り付けて、
■ﾃﾞｽｸﾄｯﾌﾟに「画像」フォルダを作製して画像ファイルを取り込んでおいて下さい
使い方は、
■画像を取り込みたいセル範囲を選択する。
■マクロ「画像ビューア」を実行する。

■■■----　以下はユーザーフォームのコードです　----■■■
Private Sub おわるButton_Click()
    Range(選択セル).Interior.ColorIndex = xlNone
    Range(選択セル).Select
    Unload UFIMG
End Sub

Private Sub ファイルリスト_Click()
Dim shph As Single, shpw As Single
Dim my As Object
Dim i As Integer
Set my = ActiveSheet
画像数 = my.Shapes.Count
    With my.Shapes
        For i = 1 To 画像数
            If .Item(i).Name <> "GAZOU" Then .Item(i).Delete
        Next
    End With
'------選択セルのサイズを知る-------
    selh = Range(選択セル).Height
    selw = Range(選択セル).Width
'------------------------------------
Application.ScreenUpdating = False
ActiveSheet.Pictures.Insert(ファイルリスト.Value).Select
Selection.Name = "new"

'------選択画像のサイズを知る---------
shph = Selection.ShapeRange.Height
shpw = Selection.ShapeRange.Width

'------選択セルのサイズと選択画像のサイズを調整する----
Selection.ShapeRange.LockAspectRatio = msoTrue
    If shph > selh Then
        Selection.ShapeRange.Height = selh
        shpw = Selection.ShapeRange.Width
    End If
    If shpw > selw Then
        Selection.ShapeRange.Width = selw
        shph = Selection.ShapeRange.Height
    End If

'------選択セルの中心に選択画像を移動する-----
If selh > shph Then Selection.ShapeRange.IncrementTop (selh - shph) / 2
If selw > shpw Then Selection.ShapeRange.IncrementLeft (selw - shpw) / 2

Application.ScreenUpdating = True
End Sub
--------------ユーザーフォームのコードここまで----------------

■■■----　以下は標準モジュールのコードです　----■■■
Public 選択セル As Variant
Public 画像数 As Integer
Public selh As Single, selw As Single

Declare Function GetWindowsDirectory Lib _
    "kernel32" Alias "GetWindowsDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function GetWinDir() As String
Dim lpBuffer As String * 260
    Call GetWindowsDirectory(lpBuffer, Len(lpBuffer))
    GetWinDir = Left(lpBuffer, InStr(lpBuffer, Chr$(0)) - 1)
End Function

Sub 画像ビューア()
Dim xFile As String
Dim 画像パス As String
Dim winパス As String
If ActiveCell.Row < 3 Then
    MsgBox "選択行が上過ぎます" 'ワークシートの上2行に説明を入れていたので
    End
End If
選択セル = ActiveWindow.RangeSelection.Address
winパス = GetWinDir
画像パス = winパス & "\ﾃﾞｽｸﾄｯﾌﾟ\画像"
Range(選択セル).Interior.ColorIndex = 6
ActiveCell.Select
    xFile = Dir(画像パス & "\")
        Do While xFile <> ""
            UFIMG.ファイルリスト.AddItem 画像パス & "\" & xFile
            xFile = Dir
        Loop
    UFIMG.Show
End Sub

------------------　標準モジュールのコードここまで　------------------

◎ 特徴解説
　・♪♪　アドインのようでアドインでない　♪　♪ベンベン♪　♪
　・見聞録2000は一応アドイン(xla)ですがアドインには組み込めません。
　・又、他のブックを起動している場合も動作しません。
　・普通のブック(xls)と同じようにダブルクリックで起動させてください。

◎ 使い方
　ダウンロードした自己解凍ファイル「knbn2000.exe」を任意のフォルダ内
に保存してダブルクリックで解凍すると以下のファイルが生成されますので、
同じフォルダ内に置いてください。

　　■　見聞録2000.xla（本体）
　　■　ReadMe.txt（このファイル）
　　■　hlpeフォルダ（ヘルプ用のhtmlファイルと関連画像が入っています）

その他、エクセル2000以上がインストールされている、見聞録2000.xlaを
ダブルクリックで起動する、それ以外特に条件等は有りません。
詳しくは起動して表示されるワークシートの「Help」ボタンから起動される
ブラウザをご覧下さい。

◎ 注意
　作者は、本ソフトウェアによる、いかなる結果にも責任を持ちません。


◎著作権について
　圧縮ファイルに含まれているデータの著作権は、「遠山 文雄」が所有していま
すが、手に入れられた方は煮るなり、焼くなり好きにしてください。バグ報告等戴
けたらうれしいですが、私は出張して屋外での仕事(鳥害対策)をしていますので
質問にはお答えできるかどうか解りませんし、更新出来るかどうかもわかりません
あしからず。
(鳥害対策に対するご質問には必ずお返事させていただきます)仕事熱心でしょ！！


◎再配布について
　金銭のやりとりを伴わない限りご自由に、事後報告でも戴けたらうれしいです。
しかし、雑誌書籍等で紹介、または配布する際には事前に必ずご連絡ください。