[三流君] −−＞ [ＶＢＡで楽しく] −−＞ [バックナンバー一覧]
−−＞ 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が保存されています。

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

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

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

フィードバック

VBA系の→[掲示板]←を覗く、質問を書き込む

評価・感想

No.045を読んだ満足度(評価)は？
5満足（参考になった）
4まぁまぁ（一部参考になった）
3普通（どちらとも言えない）
2なんかなぁ（期待と違った）
1不満（読んで損した気分）
 作者に感想・質問を送る場合は下記に気軽に書いてください
あなたのお名前（ニックネーム） さん

作者からの返信は、 不用 E-mail で受信したい
＊質問・感想はメルマガで紹介する場合があります

ページフッター(リンクや広告など)

[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列

情報を探す

情報を探すならGoogleかな？

↓Web全体、サポート情報(support.microsoft.com)や三流君VBA(ken3.org)から検索する
Google
Web www.ken3.org
www.microsoft.com support.microsoft.com
あとは、項目別にMSでお勉強かな？
◆ マイクロソフト サイトの歩き方
◇ How-To インデックス
◇ FAQ インデックス
◇ スキルレベル別おすすめコンテンツ
◇ テクノロジ マップ
◇ テーマ別技術資料一覧

書籍の購入

Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？

コンピュータ書籍の発送がハヤイ専門店

コンピュータの本・専門店
 ※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり

amazon.co.jpでキーワード別チェック

下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・