[[20040925173225]]　『Textboxの表示方法』（ガッチャン）　ページの最後に飛ぶ

『Textboxの表示方法』（ガッチャン）

ＶＢＡでシートの内容をTextboxに表示させています。日付を和暦で表示したい

のですが、フォームには西暦　例）２０００／０２／０２　で、表示されます。

和暦で表示させるにはどのようにしたらよいのでしょうか。

 Format関数でできませんか？　(wizik)

wizikさん　ありがとうございました。Format関数については、少しわかってきましたが・・・

ユーザーフォームのInitialize()イベントプロシージャの中へTextBox28.Value = Format(Range("ab5"), "gggyy\年mm\月dd\日")

と入れてみました。うまく和暦となりましたが、これではフォームが開いたときには和暦となりますが、スクロールや、コマンドボタンにより

Textboxのデータが変更されたときには、西暦となってしまします。各イベントごとにFormatを入れなければいけないのでしょうか・・・

 changeやBeforeUpdateイベントで処理しては？

  (INA)

たびたびで、申し訳ありません。いろいろやってみましたがうまくいきません・・・
また、質問の書き方が悪かったようで思うような結果が出せませんでした・・（涙）

シート（セル）の内容をTextboxに表示させ、修正等を行った場合Textboxの内容を
セルに書き戻すようにしています。セルにはすでに書式や数式（関数）等が組み込
まれており、いずれの方法もTextboxに表示された書式が元セルに上書きとなり、元
の書式＆数式が変わってしまいました。

例）元セルの書式は「日付」となっていますが、フォームに表示された和暦が、
元セルへ文字列として上書きされてしまう。

元データの書式＆数式を変更することなく、フォーム上でみたときだけ和暦となるよ
うにしたいのですが、よい方法がありましたら教えてください。

 どのような処理をしているのでしょうか？

 日付のシリアル値と、文字列の違いは把握されていますか？

 処理中の変数の型などは、日付型と文字列など気を付けていますか？

 いずれにせよ、どのような処理（修正）を行っているのか分からないと、
 アドバイスしにくいです。

  (INA)

 テキストボックスは文字通りValueがText型で返ってくるためか、
そのまま代入すると、いったん和暦文字列でセルにセットされています。
私の経験では、Format関数で西暦年文字列に戻してからセットすると
うまくいくようです。
    Private Sub UserForm_Initialize()
        Me.TextBox1.Value = Format(Sheets(1).Range("A1"), "gggee年mm月dd日")
    End Sub
    Private Sub CommandButton1_Click()
    Dim myLocal As String
        If IsDate(Me.TextBox1.Value) Then
        myLocal = Sheets(1).Range("A1").NumberFormatLocal
        Sheets(1).Range("A1").Value = Format(Me.TextBox1.Value, "yyyy/mm/dd")
        Sheets(1).Range("A1").NumberFormatLocal = myLocal
        Else
        MsgBox "不正な日付"
        End If
    End Sub
変数myLocalは蛇足かもしれませんが、手入力で日付修正するなら、
IsDateでのチェックは入れたほうがよいでしょう。
　
＞修正等を行った場合Textboxの内容をセルに書き戻す
＞元データの書式＆数式を変更することなく
書式はともかく、TextBoxのデータをセルへ代入しているのなら
関数は消えてしまいますよね。
関数は残し、なおかつその値を直接書き換える、ということはできません。
もし、関数の結果である日付データを書き換える必要があり、
なおかつその関数を残すのであれば、
そのセルに直接TextBoxの値を代入するのではなく、
関数の計算の元になる部分を修正してやる必要がありますよ。　
(KAMIYA)

 CDateで日付型に変換した値をセットしてみてはどうかしら。
KAMIYAさんの例で言うと、
        Sheets(1).Range("A1").Value = CDate(Format(Me.TextBox1.Value, "yyyy/mm/dd"))
って感じで。CDate(Me.TextBox1.Value)でも良いかも知れないけども。
（ご近所PG）

 みなさんありがとうございます。
 >関数は残し、なおかつその値を直接書き換える、ということはできません。
 >書式はともかく、TextBoxのデータをセルへ代入しているのなら
 >関数は消えてしまいますよね。
まずは、KAMIYAさんのご指摘のとおりでした。元データになるシートの中に 
手入力のセルと他のシートから拾ってくるセルがあり、他のシートから拾っ 
てくるセルは、書き変えないない（TextBoxで表示するだけ）としていました。
フォームの作成のため、手入力セルにも仮の値を入れていましたので、混同し 
ていましたお詫びします。

     A        B           C       D    E......
    名前　  受付日　　　処理日
 1　太郎　H14.01.01　 H14.01.02
 2　花子
 3
 .

 上記のような、台帳を入力フォームを作って新規登録＆修正を行っています。
 セルBは、他のシートからVLOOKUPで拾ってきています。
 セルCは、フォーム上で手入力または修正します。
 このような、データをTextBoxで表示し必要な箇所は手入力＆修正＆新規登録
 ができるようにしています。

 お恥ずかしいですが、みてください。

 '＊＊＊　「×」閉じるボタンを無効　＊＊＊
 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormontrolMenu Then
       MsgBox "「×」ボタンでは閉じることができません m(_ _)m  ",   
       vbInformation, "閉じるボタン"
       Cancel = True
    End If
 End Sub

 '＊＊＊　ユーザーフォームの初期化　＊＊＊
 Private Sub UserForm_Initialize()
    ToTextBox (5)
    ScrollBar1.Max = Range("A4").CurrentRegion.Rows.Count
    ScrollBar1.Min = 1
    With 新規登録
        .Enabled = Not .Enabled
    End With
    With クリアー
        .Enabled = Not .Enabled
    End With
 End Sub

 '＊＊＊　「修正登録」ボタン　クリック時　＊＊＊
 Private Sub 修正登録_Click()
    ToCell (ScrollBar1.Value + 4)
    ActiveSheet.Calculate             '再計算
    ToTextBox (ScrollBar1.Value + 4)
 End Sub

 '＊＊＊　「修正クリアー」ボタン　クリック時　＊＊＊
 Private Sub 修正クリアー_Click()
    ToTextBox (ScrollBar1.Value + 4)
 End Sub

 '＊＊＊　「新規」ボタン　クリック時　＊＊＊
 Private Sub 新規_Click()
    ScrollBar1.Max = Range("A4").CurrentRegion.Rows.Count
    ScrollBar1.Value = ScrollBar1.Max
    ToTextBox (ScrollBar1.Value + 5)
    Label0.Caption = "新規"

    Rows("1:1").Select
    Selection.Copy
    Rows(ScrollBar1.Value + 5).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    With 新規
        .Enabled = Not .Enabled
    End With
    With ScrollBar1
        .Enabled = Not .Enabled
    End With
    With 閉じる
        .Enabled = Not .Enabled
    End With
    With 修正登録
        .Enabled = Not .Enabled
    End With
    With 修正クリアー
        .Enabled = Not .Enabled
    End With
    With 新規登録
        .Enabled = Not .Enabled
    End With
    With クリアー
        .Enabled = Not .Enabled
    End With
 End Sub

 '＊＊＊　「クリアー」ボタン　クリック時　＊＊＊
 Private Sub クリアー_Click()
    Selection.ClearContents
    With 新規
        .Enabled = Not .Enabled
    End With
    With ScrollBar1
         .Enabled = Not .Enabled
    End With
    With 閉じる
        .Enabled = Not .Enabled
    End With
    With 修正登録
        .Enabled = Not .Enabled
    End With
    With 修正クリアー
        .Enabled = Not .Enabled
    End With
    With 新規登録
        .Enabled = Not .Enabled
    End With
    With クリアー
        .Enabled = Not .Enabled
    End With
    ToTextBox (ScrollBar1.Value + 4)
    Label0.Caption = ScrollBar1.Value & "/" & ScrollBar1.Max
 End Sub

 '＊＊＊　「新規登録」ボタン　クリック時　＊＊＊
 Private Sub 新規登録_Click()
    If ComboBox8.Text = "" Or TextBox11.Text = "" Or ComboBox14.Text = "" Then
       MsgBox "必要な項目が入力されていません", vbInformation, "未入力"
       Exit Sub
    End If
    ToCell (ScrollBar1.Value + 5)
    ActiveSheet.Calculate            '再計算
    ToTextBox (ScrollBar1.Value + 5)
    With 新規
        .Enabled = Not .Enabled
    End With
    With ScrollBar1
         .Enabled = Not .Enabled
    End With
    With 閉じる
        .Enabled = Not .Enabled
    End With
    With 新規登録
        .Enabled = Not .Enabled
    End With
    With クリアー
        .Enabled = Not .Enabled
    End With
    ScrollBar1.Max = Range("A4").CurrentRegion.Rows.Count
    ScrollBar1.Value = ScrollBar1.Max
    ToTextBox (ScrollBar1.Value + 4)
    End Sub

 '＊＊＊　「閉じる」ボタン　クリック時　＊＊＊
 Private Sub 閉じる_Click()
    Sheets("メニュー").Select
    Unload 対象物
    Unload メニュー    '後で消す・・・
 End Sub

 '＊＊＊　スクロールバー　変更時　＊＊＊
 Private Sub ScrollBar1_Change()
    ScrollBar1.Max = Range("A4").CurrentRegion.Rows.Count - 1
    ToTextBox (ScrollBar1.Value + 4)
    Label0.Caption = ScrollBar1.Value & "/" & ScrollBar1.Max
 End Sub

 '＊＊＊　セルからフォームへデータ転記　＊＊＊
 Sub ToTextBox(行位置 As Long)
    TextBox2.Value = Cells(行位置, 2).Value
    TextBox3.Value = Cells(行位置, 3).Value
    TextBox4.Value = Cells(行位置, 4).Value
      .
     省略
      .
    TextBox126.Value = Cells(行位置, 126).Value
    ComboBox8.Value = Cells(行位置, 8).Value
      .
     省略
　　　.

    ComboBox104.Value = Cells(行位置, 104).Value
 End Sub

 '＊＊＊　フォーム上のデータをワークシートに転記　＊＊＊
 Sub ToCell(行位置 As Long)
    Cells(行位置, 6).Value = TextBox6.Value
    Cells(行位置, 11).Value = TextBox11.Value
    Cells(行位置, 15).Value = TextBox15.Value
    Cells(行位置, 17).Value = TextBox17.Value
      .
     省略
      .
    Cells(行位置, 126).Value = TextBox126.Value
    Cells(行位置, 8).Value = ComboBox8.Value
      .
     省略
      .
    Cells(行位置, 104).Value = ComboBox104.Value

 End Sub

 データを表示、必要なら修正＆新規登録をし登録ボタンにより登録、フォームを
 閉じることなく、修正登録（新規登録）の内容をフォームに表示するようにして
 います。
 このようなフォームで、データセルの日付を、フォームでは和暦表示としたいの
 のですが・・？

 すいません補足です。
 お詫びにも書きましたが、他のシートから拾ってくる（関数の入っているセル）
 の値は、フォームで表示するだけで、修正＆書き戻しはしていません。手入力の
 項目のみ書き戻しています。
 ユーザーフォームの初期化時じだけでなく、コマンドボタンのクリック後やスク
 ロールバー変更時にも対応いさせたいのですが。

 例として
     A        B           C       D    E......
    名前　  受付日　　　処理日
 1　太郎　H14.01.01　 H14.01.02
 2　花子
 3
 .
 と書いていますが、実際のデータは４行目が項目で５行目からがデータです。

 なんか長々とかいてますが、結局何がしたいんですか？

 >TextBox28.Value = Format(Range("ab5"), "gggyy\年mm\月dd\日")と
 >入れてみました。うまく和暦となりましたが
 本当ですか？

 >いずれの方法もTextboxに表示された書式が元セルに上書きとなり、元の書式＆数式が変わってしまいました。
 ご近所PGさんも書いていますが、キャストするんじゃダメだったんでしょうか。 (wizik)

 Private Sub CommandButton1_Click()
     TextBox1.Value = Format(Range("a1"), "gggee年mm月dd日")
 End Sub

 Private Sub CommandButton2_Click()
     Cells(1, 1).Value = CDate(TextBox1.Text)
 End Sub

 >>TextBox28.Value = Format(Range("ab5"), "gggyy\年mm\月dd\日")と
 >>入れてみました。うまく和暦となりましたが
 >本当ですか？
そのようですね。
XL2002からはセルの書式は"gggyy"で和暦年数対応しているようですが、
VBAでの処理は"gggee"にしないとおかしくなりますね。
もしかしたら対応しているのじゃないかと思って
会社の2002で確認しましたが、だめですね。
したがって、習慣的には"gggee"を使用してょうがよさそうデス。
　
セルへの日付データ入力は、
ご近所PGさん、wizikさんご指摘のように、
「データ型変換関数」を利用してください。
そういうのがあるの自体忘れてた・・・。
(KAMIYA)

コメント返信：

[ 一覧(最新更新順) ]

[[20040925173225]] 『Textboxの表示方法』（ガッチャン） ページの最後に飛ぶ

[[20040925173225]]　『Textboxの表示方法』（ガッチャン）　ページの最後に飛ぶ