Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18447 / 76736 ←次へ | 前へ→

【63731】Re:ユーザーフォームでの計算
発言  kanabun  - 09/12/4(金) 15:38 -

引用なし
パスワード
   ▼やまあらし さん:

>txtBox1〜40のどれかの値が、変更するたびに
>txt合計金額 と txtおつり金額 の値が変わるように
>できますか?

前のサンプルでは 隠しシートのChangeイベントプロシージャ
に、セルの値が変更したら シートの[C2]セルの合計金額を
UserFormの txt合計金額 に転記する処理を書いてましたが、
シートのほうに書かずに UserForm内に書いて同じことが
できましたね。
  (以下、そのサンプルです。 隠しシートのイベント
   プロシージャのほうは 削除しちゃってお試しください)
'---------------------------------------
Option Explicit

Private WithEvents WkSheet As Excel.Worksheet  '◆ 変更

Private Sub UserForm_Initialize()
  Dim i As Long
  On Error Resume Next
   Set WkSheet = Worksheets("Hidden")
  On Error GoTo 0
  If WkSheet Is Nothing Then
    Set WkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    With WkSheet
      .Name = "Hidden"
      .Visible = False
      .[B1:B10].Value = Application.Transpose( _
        Array(150, 200, 300, 98, 198, 298, 398, 200, 150, 300))
      .[C2].Formula = "=SUMPRODUCT(A1:A10,B1:B10)"
      .[C3].Formula = "=C1-C2"
    End With
  End If
  WkSheet.[A1:A40].ClearContents
  For i = 1 To 10 '40
    Me("TextBox" & i).ControlSource = "Hidden!A" & i
  Next
End Sub

Private Sub txt預かり金額_Enter()
  txt合計金額.Text = Range("Hidden!C2").Value
End Sub

Private Sub txt預かり金額_Change()
  Range("Hidden!C1").Value = Val(txt預かり金額.Text)
End Sub

Private Sub txt預かり金額_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  txt合計金額.Text = Range("Hidden!C2").Value
  txtおつり金額.Text = Range("Hidden!C3").Value
End Sub

Private Sub WkSheet_Change(ByVal Target As Range) '◆追加
  Dim r As Range
  Set r = Intersect(Target, WkSheet.[A1:A40])
  If Not r Is Nothing Then
    txt合計金額.Text = WkSheet.[C2].Value
  End If
End Sub

0 hits

【63727】ユーザーフォームでの計算 やまあらし 09/12/3(木) 18:50 質問
【63728】Re:ユーザーフォームでの計算 kanabun 09/12/3(木) 20:09 発言
【63729】Re:ユーザーフォームでの計算 kanabun 09/12/3(木) 20:29 発言
【63731】Re:ユーザーフォームでの計算 kanabun 09/12/4(金) 15:38 発言
【63732】Re:ユーザーフォームでの計算 やまあらし 09/12/4(金) 16:43 お礼

18447 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free