[三流君] −−＞ [ＶＢＡで楽しく] −−＞ [バックナンバー一覧]
−−＞ No.045 歌詞の表記を参考に関数を作成

歌詞の表記を参考に関数を作成

メルマガ発行内容

＜歌詞の表記を参考に関数を作成＞

こんにちは、三流プログラマーＫｅｎ３です。

今回は、
関数のまとめ方、歌詞の表記を参考に
を少し書きます。

気楽に読んでください。

/*
 * １．大きなのっぽの古時計
*/

  　大きなのっぽの古時計　おじいさんの時
　　百年いつも動いてた　ご自慢の時計さ
　　おじいさんの生まれた朝に買ってきた時計さ
　　いまはもう動かない　その時計

　　　　（＊）百年休まずに　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　　　チクタクチクタク
　　　　　　　おじいさんといっしょに
　　　　　　　チクタクチクタク
　　　　　　　いまはもう動かない
　　　　　　　その時計

  　なんでも知ってる古時計　おじいさんの時
　　きれいな花嫁やってきた　その日も動いてた
　　うれしいこともかなしいことも　みな知ってる時計さ
　　いまはもう動かない　その時計

　　　　（＊）繰り返し

  　真夜中にベルがなった　おじいさんの時
　　お別れのときがきたのを　みなにおしえたのさ
　　天国へ昇るおじいさん　時計ともおわかれ
　　いまはもう動かない　その時計

　　　　（＊）繰り返し

有名な歌ですよね、私でも知ってます。
最近、みなさんは、どんな歌聞いてますか？
心が落ち着く歌あったら、教えてください、
また、キーボードをノリノリで打てる歌、プログラミング中にお進めの歌など、
掲示板に書いてくれると、うれしいです。

何がいいたいんだよ、オマエは。

あっ、忘れてた。
歌詞の書き方、表現の仕方、
（＊）繰り返し
^^^^^^^^^^^^^^^
と同じサビの部分を書いてます。
プログラムも同様にまとめられる部分はまとめましょうよ。ってことで、

/*
 * ２．前、作成したExcel画像管理サンプルを修正する
*/

Excelで画像管理のサンプル、Formの作成を
In message "[VBAで楽しく No.042] - ExcelのForm シートと連動させる",
/vba/backno/vba042.html
でやりました。サンプルファイルは、
http://www.ken3.org/vba/lzh/vba042.lzh
にtest042-book.xlsが保存されています。

まぁ、問題ありのプログラムなんだけど、
今回は、同一処理を関数化してまとめてみたいと思います。

下記、問題のソースファイルです(長いよ)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim yCNT As Integer '行カウンター

Private Sub btnNEXT_Click()
    
    Dim strFNAME As String 'ファイル名作成用
    
    '次の位置を計算
    yCNT = yCNT + 1   '行カウンタを増やす
    
    'セルの値をフォームのテキストボックスに代入する
    txtTITLE = Sheets("DATA").Cells(yCNT, "A")
    txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
    txtMEMO = Sheets("DATA").Cells(yCNT, "C")
    
    '画像ファイルを表示する
    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If

End Sub

Private Sub btnPREV_Click()
    
    Dim strFNAME As String 'ファイル名作成用
    
    '前の位置を計算
    yCNT = yCNT - 1   '行カウンタを減らす
    
    'セルの値をフォームのテキストボックスに代入する
    txtTITLE = Sheets("DATA").Cells(yCNT, "A")
    txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
    txtMEMO = Sheets("DATA").Cells(yCNT, "C")
    
    '画像ファイルを表示する
    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If

End Sub

Private Sub txtFILENAME_Change()
    'テキストボックスの値をシートへ代入
    Sheets("DATA").Cells(yCNT, "B") = txtFILENAME
    '画像ファイル名が変更されたので、画像の処理を行う
    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If
End Sub

Private Sub txtMEMO_Change()
    'テキストボックスの値をシートへ代入
    Sheets("DATA").Cells(yCNT, "C") = txtMEMO
End Sub

Private Sub txtTITLE_Change()
    'テキストボックスの値をシートへ代入
    Sheets("DATA").Cells(yCNT, "A") = txtTITLE
End Sub

Private Sub UserForm_Initialize()
    
    'ディレクトリが入って無い時、ブックのパスを代入
    If Len(Sheets("DATA").Range("E1")) = 0 Then
        Sheets("DATA").Range("E1") = ThisWorkbook.Path & "\"
    End If
    
    Dim strFNAME As String 'ファイル名作成用
    
    '初期処理
    yCNT = 2   '初期値の２行目を代入
    
    'セルの値をフォームのテキストボックスに代入する
    txtTITLE = Sheets("DATA").Cells(yCNT, "A")
    txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
    txtMEMO = Sheets("DATA").Cells(yCNT, "C")
    
    '画像ファイルを表示する
    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If
    
End Sub

うわ、ダラダラと長いよね
^^^^^^^^^^^^^^
恥ずかしく無いの？よく人前に出せたよね。。。こんなの（笑）

/*
 * ３．よく見ると、同じような処理が、、、、
*/

よく見ると、
セルの値を代入している処理
    'セルの値をフォームのテキストボックスに代入する
    txtTITLE = Sheets("DATA").Cells(yCNT, "A")
    txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
    txtMEMO = Sheets("DATA").Cells(yCNT, "C")
と
画像ファイルの表示処理
    '画像ファイルを表示する
    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If
が
同じことに気が付くと思います。
~~~~~~~~~~~~~~~~~~
これを、歌詞の表記(＊)のようにまとめたいと思います。
Sub SheetToForm() 'セルの値をフォームのテキストボックスに代入する

    txtTITLE = Sheets("DATA").Cells(yCNT, "A")
    txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
    txtMEMO = Sheets("DATA").Cells(yCNT, "C")

End Sub

Sub PUTPicture() '画像ファイルを表示する

    Dim strFNAME As String 'ファイル名作成用

    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If

End Sub

とSub関数化して、
Call PUTPicture
Call SheetToForm
で呼んでみます。

下記、修正後のソースファイルです。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim yCNT As Integer '行カウンター

Private Sub btnNEXT_Click()
    
    '次の位置を計算
    yCNT = yCNT + 1   '行カウンタを増やす
    
    'セルの値をフォームのテキストボックスに代入する
    Call SheetToForm
    
    '画像ファイルを表示する
    Call PUTPicture

End Sub

Private Sub btnPREV_Click()
    
    '前の位置を計算
    yCNT = yCNT - 1   '行カウンタを減らす
    
    'セルの値をフォームのテキストボックスに代入する
    Call SheetToForm
    
    '画像ファイルを表示する
    Call PUTPicture

End Sub

Private Sub txtFILENAME_Change()
    'テキストボックスの値をシートへ代入
    Sheets("DATA").Cells(yCNT, "B") = txtFILENAME
    '画像ファイル名が変更されたので、画像の処理を行う
    Call PUTPicture
End Sub

Private Sub txtMEMO_Change()
    'テキストボックスの値をシートへ代入
    Sheets("DATA").Cells(yCNT, "C") = txtMEMO
End Sub

Private Sub txtTITLE_Change()
    'テキストボックスの値をシートへ代入
    Sheets("DATA").Cells(yCNT, "A") = txtTITLE
End Sub

Private Sub UserForm_Initialize()
    
    'ディレクトリが入って無い時、ブックのパスを代入
    If Len(Sheets("DATA").Range("E1")) = 0 Then
        Sheets("DATA").Range("E1") = ThisWorkbook.Path & "\"
    End If
    
    '初期処理
    yCNT = 2   '初期値の２行目を代入
    
    'セルの値をフォームのテキストボックスに代入する
    Call SheetToForm
    
    '画像ファイルを表示する
    Call PUTPicture

End Sub

Sub SheetToForm() 'セルの値をフォームのテキストボックスに代入する
    txtTITLE = Sheets("DATA").Cells(yCNT, "A")
    txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
    txtMEMO = Sheets("DATA").Cells(yCNT, "C")
End Sub

Sub PUTPicture() '画像ファイルを表示する
    Dim strFNAME As String 'ファイル名作成用
    
    If Trim(txtFILENAME) = "" Then  'ファイル名が入力されているかチェック
        imgBOX.Picture = LoadPicture("")  '画像を消す
        Exit Sub
    End If
    strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
    If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
        '存在していない時
        imgBOX.Picture = LoadPicture("") '画像を消す
    Else
        imgBOX.Picture = LoadPicture(strFNAME)  'ファイル名をセット
    End If
End Sub

やっと、スッキリしたよね。
プログラム、プログラムってのは、、関数化と偉そうに言ってるけど、
歌詞の表記と同様に、同じ処理をまとめただけでした。

まぁ、これもひとつの書き方で、
プログラムらしいってのは、まだまだあって、
パラメーターを受け取って仕事をする関数
や
仕事をして結果を返す関数
など、
組み合わせてスッキリしたプログラムを書きましょう（説明して行きます）

In message "[VBAで楽しく No.024] - 関数のパターンを少し",
/vba/backno/vba024.html
でも軽く書いてます、合わせて見て笑ってください。
（この説明の時、歌詞の例題を思いつかなかった）

/*
 *　４.おわりの挨拶
*/

今回は、
・音楽は何が好きですか？
・関数化して、同じ処理をまとめる
でした。

修正した、Excelで画像管理サンプルを
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba045.lzh
にtest045-book.xlsが保存されています。

何か素朴な疑問などあったら、メール、掲示板に気軽に書いてください。

拾い読みして、
１つでも何かの参考となれば幸いです。

Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。

ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、

種類別のリンク や 広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他：VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]


[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]