Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Excel 2010)
シートに行の追加位置によってユーザフォームが表示されません
投稿日時: 17/06/12 13:50:50
投稿者: kim358

申し訳ありませんが、識者の皆様のお力添えをお願いいたします。
 
処理:
・作成フォーム「データ入力フォーム」と「処理振分フォーム」
・Sheets1 で A列のセルを選択変更またはダブルクリック
・アクティブセルの値が "" なら入力フォームを表示する。
・入力済みなら「処理振分フォーム」を表示する。
 (【前に行を追加】、【下に行を追加】、【現在の行を編集】の3ボタンを設置)
・【前に行を追加】では現在行の前(上)に1行挿入して入力フォーム表示(正常に表示)
・【現在の行を編集】入力フォーム表示(正常に表示)
【下に行を追加】では入力フォームが表示されません。(エラー等の表示もありません)
 
ステップ実行をしてみましたが、ユーザフォームのイニシャライズ処理などは、
どのボタンをクリックでも全く同じステップを実行します。
 
行追加後の A列をダブルクッリクすると入力フォームは表示されるのでとりあえず処理は行えますが、
なぜ下に行を挿入した時は入力フォームが表示されないのかわかりません。
 
以下にコードを示しますので、ご指摘をよろしくお願いします。
 
シートモジュール(Sheets1)
Option Explicit
 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Call frmCLOSE("")           'フォームが開いていれば閉じる
    On Error Resume Next        '大量のセルが選択されている場合のエラー対処
    If Target.Count > 1 Then Exit Sub
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    If Target.Row < 3 Or Target.Column > 1 Then Exit Sub

    Cancel = True
    If Target.Value = "" Then
        frmEVNT.Show vbModeless
    Else
        frmCHCK.Show vbModeless
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call frmCLOSE("")           'フォームが開いていれば閉じる
    On Error Resume Next        '大量のセルが選択されている場合のエラー対処
    If Target.Count > 1 Then Exit Sub
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    If Target.Row < 3 Or Target.Column > 1 Then Exit Sub

    If Target.Value = "" Then
        frmEVNT.Show vbModeless
    Else
        frmCHCK.Show vbModeless
    End If
End Sub

Private Sub frmCLOSE(ByVal pDMY As String)
    Dim f As UserForm
    'ユーザーフォームが開いていれば閉じる
    For Each f In UserForms
        If TypeOf f Is frmEVNT Then
            Unload frmEVNT
        End If
        If TypeOf f Is frmCHCK Then
            Unload frmCHCK
        End If
    Next
End Sub

フォームモジュール(frmCHCK)
Option Explicit

Private Sub btnMAE_Click()
    Unload Me
    Application.EnableEvents = False
    Rows(ActiveCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.EnableEvents = True
    frmEVNT.Show vbModeless
End Sub

Private Sub btnATO_Click()
    Unload Me
    Application.EnableEvents = False
    ActiveCell.Offset(1).Select         [color=red]'違いはこのステップがあるかないかだけ[/color]
    Rows(ActiveCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.EnableEvents = True
    frmEVNT.Show vbModeless
End Sub

ユーザフォーム(frmEVNT)
'キャンセルボタン(クリック)
Private Sub btnCAN_Click()
    Unload Me
End Sub
'登録ボタン(クリック)
Private Sub btnOK_Click()
    ActiveCell.Value = "・"
    ActiveCell.HorizontalAlignment = xlCenter
    ActiveCell.Offset(, 1).Value = frmEVNT.evntNAM.Text
    ActiveCell.Offset(, 1).NumberFormatLocal = "_)@"
    ActiveCell.Offset(, 3).Value = frmEVNT.evntBGN.Text
    ActiveCell.Offset(, 3).NumberFormatLocal = "yyyy/mm/dd"
    ActiveCell.Offset(, 4).Value = frmEVNT.evntDAY.Text

    Unload Me
End Sub

Private Sub UserForm_Initialize()
    '登録済みのデータセット
    Me.evntNAM.Text = ActiveCell.Offset(, 1).Value
    If ActiveCell.Offset(, 3).Value = "" Then
        Me.evntBGN.Text = ""
    Else
        Me.evntBGN.Text = Format(ActiveCell.Offset(, 3).Value, "yyyy/mm/dd")
    End If
    Me.evntDAY.Text = ActiveCell.Offset(, 4).Value
End Sub

回答
投稿日時: 17/06/12 14:55:22
投稿者: WinArrow
投稿者のウェブサイトに移動

> (【前に行を追加】、【下に行を追加】、【現在の行を編集】の3ボタンを設置)
この説明が無いような気がします。
 
ボタンはどこに?
ボタンにはマクロがあるものと思いますが、コードは?

投稿日時: 17/06/12 15:25:08
投稿者: kim358

WinArrow 様
 
コメントありがとうございます。
 
【前に行を追加】、【下に行を追加】、【現在の行を編集】の3ボタンは、「処理振分フォーム」に
配置しております。
 
ボタンに応じた処理は、フォームモジュール(frmCHCK)に、
【前に行を追加】  Private Sub btnMAE_Click()
【下に行を追加】  Private Sub btnATO_Click()
【現在の行を編集】 Private Sub btnEDIT_Click()
で、定義しています。
最初のに【現在の行を編集】のプロシジャーが抜けていました。

Private Sub btnEDIT_Click()
    Unload Me
    frmEVNT.Show vbModeless
End Sub

 
処理の流れとしては、
【前に行を追加】のクリックでアクティブとなっているセルの行の前に1行挿入
【下に行を追加】のクリックでアクティブとなっているセルの行の下に1行挿入
それぞれ挿入した行のカラム1をアクティブセルとする
【現在の行を編集】の場合はそのまま
として、frmEVNT を表示したいのです。
 btnMAE_Click() と btnATO_Click()の違いは、btnATO_Click()の行挿入の前に
「ActiveCell.Offset(1).Select」の行があることだけです。
 
よろしくお願いいたします。

回答
投稿日時: 17/06/12 15:49:54
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
btnMAE_Click() と btnATO_Click()の違いは、btnATO_Click()の行挿入の前に
「ActiveCell.Offset(1).Select」の行があることだけです。

 
思い込みで説明しないこと
回答者には、あなたのPCの画面は見えません。
手抜きせず、回答者にも見えるように、
具体的なコードを掲示しましょう。

投稿日時: 17/06/12 16:20:43
投稿者: kim358

WinArrow 様
  
コメントありがとうございます。
 
コードについては、最初の投稿で btnEDIT_Click()
が抜けた以外はすべて記載しています。
 
シートモジュールの【Worksheet_SelectionChange】で、3行目以下の 1列目が選択変更されるか
【Worksheet_BeforeDoubleClick】で、3行目以下の 1列目のセルがダブルクリックンされた際に
【frmEVNT】を表示するか、【frmCHCK】を表示するかとなっています。
 
現在、Excelを起動し直して新しいブックでテストしましたがこれはうまくいきました。
シートモジュール
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
    UserForm2.Show vbModeless
End Sub
 
フォーム1
Option Explicit
Private Sub UserForm_Initialize()
    Me.TextBox1.Text = ActiveCell.Value
End Sub
 
フォーム2
Option Explicit
Private Sub CommandButton1_Click()
    Unload Me
    Application.EnableEvents = False
    Rows(ActiveCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.EnableEvents = True
    UserForm1.Show vbModeless
End Sub
Private Sub CommandButton2_Click()
    Unload Me
    Application.EnableEvents = False
    ActiveCell.Offset(1).Select
    Rows(ActiveCell.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.EnableEvents = True
    UserForm1.Show vbModeless
End Sub
 
これを確認してから
作成中のファイルにもどり、うまくいっている「btnMAE_Click()」のコードを全てコピーして
実行すると、アクティブセルの行が下に行き追加した行がアクティブとなり、データ入力フォームが
表示されることをを確認し
ActiveCell.Offset(1).Select
を追加すると、データ入力フォームは残念ながら表示されません。
 
何が悪いのか全く生きず待っています。
よろしくお願いいたします。

回答
投稿日時: 17/06/12 20:17:30
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
引用:
ステップ実行をしてみましたが、ユーザフォームのイニシャライズ処理などは、
どのボタンをクリックでも全く同じステップを実行します。
  
行追加後の A列をダブルクッリクすると入力フォームは表示されるのでとりあえず処理は行えますが、
なぜ下に行を挿入した時は入力フォームが表示されないのかわかりません。

 
ステップ実行で、コード実行が確認できているのでしたら
表示されないということはおかしい。
 
掲示のコードでは、全く表示されないということは考えにくい。
 
まだ、説明してないことありませんか?

投稿日時: 17/06/13 08:49:12
投稿者: kim358

WinArrow 様
 
ありがとうございます。
説明漏れはないと思っています。
 
昨日、友人のPCで試してもらったら期待通りの動きをしました。
「Windows7 + Excel2010」、「Windows10 + Excel2013」
 
また、昨日新しいBookで最小の動きを試して期待通りになったことから
そのBookでフォームの作り直しし、コードは全てコピーしたところ、
期待通りの動きとなりました。
 
最初のBookでは、日付の表示形式を設定しても
    ActiveCell.Offset(, 3).Value = frmEVNT.evntBGN.Text
    ActiveCell.Offset(, 3).NumberFormatLocal = "yyyy/mm/dd"
日付形式で表示されずシリアル値が表示される事象も起きており
Bookに何らかの異常があったと思います。
 
まだ作り始めたばかりのところで機がつき幸いでした。
 
これからも不明な点が出てくると思いますので、ご指導をお願いすることに
なると思いますので、宜しくお願いいたします。
 
ありがとうございました。