エクセルVBA リストボックスで選択した値の、該当行を選択して塗りつぶす際の実行時エラーについて

Question

超初心者です。以前こちらで教えていただきました下記の件で、引き続き教えていただきたく、よろしくお願いいたします。自宅のPCのバージョンは2016で問題なく実行できましたが、肝心の職場の共有環境のバージョン2010で同様に何度も作成してみましたが、「実行時エラー438　オブジェクトはこのプロバティまたはメソッドをサポートしていません。」とでてフォームのリストボックスが空のまま表示され、デバッグするとUserForm.Showが黄色くなり、表に戻るとコピーする範囲は選択されているが作業シートに何もコピーされていない状態です。下記の部分を書き換えてみたらリストボックスのリストは表示されましたが、なにが原因でしょうか？バージョンにより何か設定等が必要なのでしょうか？困っています。アドバイスをよろしくお願いいたします。
---------------------------------------------------------------
Option Explicit
Private lastrow As Long
Private maxcol As Long
Private maxrow As Long
Private saverow As Long
Private sortedFlag As Boolean
Private gmakedFlag As Boolean
Const baseSheetName As String = "成績表"
Const workSheetName As String = "作業"
Const No_koutei As Long = 19    '工程数
Const X_ratio As Double = 1#      'グラフ横軸倍率
Const Y_ratio As Double = 1#    'グラフ縦軸倍率
Const Y_unit As Long = 5        'グラフ縦軸目盛単位
---------------------------------------------------------------
Private Sub UserForm_Initialize()
  Dim i As Long
    'Call CopyData                       ←← ここをコメントにして
       For i = 3 To maxrow           ←←maxrowの部分をCells(Rows.Count,1).End(xlup).Rowに　　　　　　　　　　　　　　　　　　　置き換えるとリストボックスのリストは正しく表示されました。

    名前リスト.AddItem Cells(i, 1)    
  Next i
End Sub
---------------------------------------------------------------
Private Sub 名前リスト_Click()
Dim i As Long
Dim j As Long
Dim row As Long
Dim col As Long
Dim no As Long
Call CopyData
no = 名前リスト.ListIndex
row = no + 3
 '選択した氏名と成績をコピー
Range(Cells(saverow, 1), Cells(saverow, maxcol)).Value = Range(Cells(row, 1), Cells(row, maxcol)).Value
'順位を設定（1期～4期）
For i = 1 To 4
For j = 1 To No_koutei
col = GetCol2(i, j)
If Cells(saverow, col).Value <> "" Then
Cells(saverow + 1, col).Value = WorksheetFunction.Rank(Cells(saverow, col).Value, Range(Cells(3, col), Cells(maxrow, col)), 0)
End If
Next
Next
'選択された氏名の背景色を設定（1期～4期）
For i = 1 To 4
col = GetCol1(i)
Range(Cells(row, col), Cells(row, col + No_koutei)).Interior.Color = 15773696
Next
lastrow = row
End Sub
-----------------------------------------------------------------------------
'期(i=1～4)を与えて、そのカラム位置（氏名のカラム位置）を返す
Private Function GetCol1(ByVal i As Long) As Long
GetCol1 = (i - 1) * (No_koutei + 2) + 1
End Function
'期(i=1～4)と工程(j=1～19)を与えて、そのカラム位置を返す
Private Function GetCol2(ByVal i As Long, ByVal j As Long) As Long
GetCol2 = (i - 1) * (No_koutei + 2) + j + 1
End Function
------------------------------------------------------------------------------
'元データを作業シートへコピー
Private Sub CopyData()
Dim i As Long
Dim rg As String
Dim end_colstr As String
maxcol = (No_koutei + 1) * 4 + 3
end_colstr = ConvertToLetter(maxcol)
maxrow = Worksheets(baseSheetName).Cells(Rows.Count, 1).End(xlUp).row
'前回表示された内容を全てクリア
Worksheets(workSheetName).Cells.Clear
 rg = "A1:" & end_colstr & maxrow
'表の全領域をコピー(A1～CEx)(x=A列の最大行)
Worksheets(baseSheetName).Range(rg).Copy Worksheets(workSheetName).Range(rg)
 '作業シートをアクティベイト
 Worksheets(workSheetName).Activate
 'グラフを削除
Worksheets(workSheetName).Cells(1, 1).Select
 If ActiveSheet.ChartObjects.Count > 0 Then
 ActiveSheet.ChartObjects.Delete
End If
 'フラグ及び変数の初期化
 lastrow = 0
sortedFlag = False
 gmakedFlag = False
 saverow = maxrow + 2
End Sub
----------------------------------------------------
'列番号を英文字に変換
Function ConvertToLetter(ByVal iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
 iAlpha = Int((iCol - 1) / 26)
 iRemainder = iCol - (iAlpha * 26)
 If iAlpha > 0 Then
 ConvertToLetter = Chr(iAlpha + 64)
End If
 If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
----------------------------------------------------------------------
'人数とメモリ単位を与えてスケールの最大値を計算する
Private Function GetMaxScale(no_person, unit)
Dim i As Long
 i = 0
Do While True
GetMaxScale = i * unit + 1
If GetMaxScale >= no_person Then Exit Do
  i = i + 1
 Loop
End Function

tatsu99 · Accepted Answer

申し訳ありません。
こちらでこのマクロを実行したところ
下記の箇所でエラーとなってしまいました。
ActiveChart.FullSeriesCollection(1).Select
当方のexcelのバージョンは2007ですのでexcel2010で作成したマクロは実行できない箇所があります。
その為、こちらで動作確認ができません。
申し訳ありませんが、本件は対応できません。ごめんなさい。

tatsu99 · Answer

＞また、ご報告いたします。よろしくお願いいたします。
その時、以下の点、ご報告をお願いします。
No5、No6のブレイクポイントでの結果。
①でのmaxrowの値
②でのmaxrowの値
上記の値を報告してください。（ソースは修正前の状態に戻してから行ってください）

tatsu99 · Answer

No5です。
②のブレイクポイントの画像です。

tatsu99 · Answer

No2です。
確認の方法ですが、
以下の2か所にブレイクポイントを設定して下さい。
①Private Sub CopyData()内の
Worksheets(workSheetName).Cells.Clearの行
添付図、参照。
添付図の●印の箇所にマウスを移動し、クリックすると設定されます。（赤線で囲んだところ）
（もう一度、クリックすると解除されます）

②Private Sub UserForm_Initialize()内の
For i = 3 To maxrowの行

上記のブレイクポイント設定後に実行します。
①の箇所で止まりますので、その上の行の
maxrow = Worksheets(baseSheetName).Cells(Rows.Count, 1).End(xlUp).rowの
maxrowにマウスを当ててください。そうすると、maxrowの値が表示されます。
こちらの環境では40名なので42が表示されます。（A列最後の行の値ならOKです）（赤線で囲んだところ）
上記確認後、処理を続行します。（実行ー＞継続）
すると②の箇所で止まります。
ここで、maxrowにマウスをあて、その値を確認してください。
①と同じ値ならOKです。

上記の結果で、
①でNGなら、成績表のレイアウト不正。
①でOK、②でNGなら、余分なコードが入り込み、maxrowの値が変更されている。（余分なコードの削除が必要）となります。
上記の結果を報告していただけますか。

tatsu99 · Answer

No2です。
こちらで、マクロを作成し、試験したのはexcel2007の環境です。
ですので、バージョンの問題は（ないとは言い切れませんが）考えにくいです。
成績表のシートに問題がないか（特にA列）、再度確認をしてください。

tatsu99 · Answer

No2です。
追加の確認です。
職場のexcelファイルを自宅にもっていき、自宅のexcelでそのファイルを動かすとどうなりますか。
それで、OKなら、バージョンの問題になります。
NGの場合は、職場のexcelファイルのデータの問題になります。

tatsu99 · Answer

前回、回答者です。
No1の方が言われるように、ステップ実行してみてください。
特に、Private Sub CopyData()のなかで、
maxrow = Worksheets(baseSheetName).Cells(Rows.Count, 1).End(xlUp).row
を実行したあとで、maxrow の値を確認してみてください。（これが正しくないような気がします）

それで、もし、おかしな値になっているなら、
maxrow = Worksheets(baseSheetName).Cells(Rows.Count, 1).End(xlUp).row
の直前に
Worksheets(baseSheetName).Activate
を入れて見てください。

私の直感では、肝心の職場の共有環境のバージョン2010のエクセルのデータ自体に問題があるような気がします。
あなた個人の環境では問題ないとのことなので、その問題ないexcelのファイルを職場に持っていき、職場のexcelであなたのファイルを動かしてみてはいかがでしょうか。それで動かないなら、バージョンの問題ということになります。

くんこば · Answer

ステップ実行はご存知？
やってみてもだめ？

一旦、プロシージャをバラバラにして、個別に実行してみては？

エクセルVBA リストボックスで選択した値の、該当行を選択して塗りつぶす際の実行時エラーについて

申し訳ありません。

＞また、ご報告いたします。

No5です。

No2です。

No2です。

No2です。

前回、回答者です。

ステップ実行はご存知？

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング