[[20130517102716]]　『ファイル内全ての特定文字列をコントロールに置き』（ケビン）　ページの最後に飛ぶ

『ファイル内全ての特定文字列をコントロールに置き換えたい』（ケビン）
Excel2003

以下の通り　置き換え処理を作成したのですが、
思ったシート、セルでないところにペーストされてしまいます。
どこがいけないのでしょうか

Sub All_Change()

 Dim sh As Worksheet
 Dim sh_now As Worksheet

  For Each sh In Worksheets
   Set sh_now = sh
    If sh.Name <> "Control_LIST" Then
        '４０列　７０行
            For i = 1 To 40
                For ii = 1 To 70
                    If Cells(ii, i).Value = "?3" Then

                        Worksheets("Control_LIST").Shapes("ComboBox_Mtool").Copy
                        Application.Goto sh_now.Cells(ii, i)
                        combo_name = "ComboBox_Mtool" + Format(Now(), "YYYYMMDDhhmmss")
                        With sh_now
                            .Paste
                            DoEvents        'おまじない
                            .Shapes(.Shapes.Count).Name = combo_name

                        End With

                        Call Combo_Set(sh_now, sh_now.Shapes(sh_now.Shapes.Count).DrawingObject)

                    End If
                Next
            Next
      End If
    Next
MsgBox "一括変換完了"

End Sub

 >思ったシート、セルでないところにペーストされてしまいます。

 思ったシートはどこで、思ったセルはどこ？

 追記）貼り付け実行は　Call Combo_Set(sh_now, sh_now.Shapes(sh_now.Shapes.Count).DrawingObject)　だから
 　　　Combo_Set　プロシジャコードもアップしないとね。

 (ぶらっと)

ぶらっとさん　こんにちは

思ったシートはどこで、思ったセルはどこ？

"？3"と入力されているセル、そのセルがあるシートを想定してました。
それで
"？3"と入力されているセル　→　Cells(ii, i)
そのセルがあるシート　→　sh_now
であるので　
Application.Goto sh_now.Cells(ii, i)
としてみましたが　違うのでしょうか？

Combo_Set（）は下の通りです。

Sub Combo_Set(sheet_nm As Worksheet, combo_ctl As Object)
Option Explicit

    Dim ctl As Object
    Dim cnt As Integer
    Dim i As Integer
    Dim sh As Worksheet
    Dim myArray() As Variant
    Dim strElements() As String
    Dim intRow As Integer
    Dim ii As Integer

Set sh = sheet_nm
Set ctl = combo_ctl
' i = 1

  i_count = 1

        'Connectionの作成
       Set con = CreateObject("ADODB.Connection")

       'ODBCでの接続:  ユーザーID､パスワード､データソースなどを設定します｡
       constr_imes = "Provider＊＊;"

       'Connectionを”constr”で開く
       con.Open constr_imes

      'RecordSetの作成
       Set rs1 = CreateObject("ADODB.Recordset")

        STRsql = ""
        STRsql = STRsql & "  SELECT count(＊＊"

        rs1.Open STRsql, con

        intRow = rs1(0).Value
        'クローズ処理
        rs1.Close

       'レコードセットの作成 (SELECT文の実行)
           STRsql = ""
           STRsql = STRsql & "  SELECT ＊＊"

           'SQLを実行して対象をRecordSetに入れる
           rs1.Open STRsql, con

            If intRow = 0 Then
                MsgBox "条件に一致する製品名はありません"
                Exit Sub
            End If

            ReDim strElements(intRow, 2)

            For i = 0 To intRow - 1
                For ii = 0 To 1
                    strElements(i, ii) = rs1(ii).Value
                Next
                rs1.MoveNext
            Next

            With ctl.Object
               .ColumnCount = 2    '表示列数の設定
               .TextColumn = 1     '表示列の設定
               .BoundColumn = 2    '値として取得する列の設定
'               .List() = myArray() 'リスト項目の設定
               .List() = strElements 'リスト項目の設定

           End With

           'クローズ処理
             rs1.Close
             con.Close
End Sub
（ケビン）

 これからコードを読んでみるけど

 Sub Combo_Set(sheet_nm As Worksheet, combo_ctl As Object) 
 Option Explicit

 これはだめだよ。
 前スレで Option Explicit 記述を推奨したけど、これは　プロシジャの先頭ではなく、「モジュールの先頭」に書かなきゃいけない。
 これだと、コンパイラーから叱られて、実行できないはずだよ？

 (ぶらっと)

 ご指摘通り　外して　実行してみると
想定していないシート及びセルにペーストされるのですが
シート及びセルの指定が違うのでしょうか
（ケビン）

 まだコードを読んでいないのでしばらくお待ち乞う。

 ところで、コンボボックスのコピーだけど、１つのシートの中に ?3 と書かれたセルが複数あれば
 そのシートに、複数、コンボボックスをコピーするの？
 それとも、１つのシートには　１つだけ？

 ●追記で

 　?3 はどのシートにある？
 　コードでは一応、"Control_LIST"　以外のシートをループで取り出しているけど
 　?3 を判定しているコードは　If Cells(ii, i).Value = "?3" Then　だから、
 　マクロ実行時点でたまたまアクティブになっているシートのセルをチェックしてるよ？（もし、このコードが標準モジュールに書かれているとすれば）
 　それでいいの？

 (ぶらっと)

 コンボボックスをコピーしているのは、Combo_Set　じゃなかったね。（年と共に物忘れが激しくなってきている）
 なので、All_Change　プロシジャ内の問題だね。

 たぶん、If Cells(ii, i).Value = "?3" Then　が具合を悪くさせている原因だと思うけど
 ↑で質問している ?3 は、どこのシートにあるのかということと、そのシートに複数あるのかということが
 ポイントなので、その返事をもらってから対応する。

 (ぶらっと)

 > たぶん、If Cells(ii, i).Value = "?3" Then　が具合を悪くさせている原因だと思うけど
ご指摘通り　If sh.Cells(ii, i).Value = "?3" Then　
とすると　1シート　につき　一つ目までは　上手く　ペーストされました。

懸念されてます通り
"Control_LIST"　以外のシート　すべてのシート及びセルに
"?3"があれば全て（複数）をコンボボックスに置き換えようとしてます。

昨日　機能ボタンでシートとセルを指定させ　ペーストしようとしてましたが
利用者からいちいち面倒との指摘があり　ユーザは全てのシートに?3を記入するだけ
で後はボタンで一括置き換えをする様　変更している次第です。

 (ケビン)

 >一つ目までは　上手く　ペーストされました

 この意味は二つ目がペーストされなかったということ？
 そうじゃなく、というか・・・ペーストされたけど、エラーになったということじゃない？
 エラーで止まった時のシートには二つ目のコンボボックスもあったと思うんだけど？

 ペーストした後

 combo_name = "ComboBox_Mtool" + Format(Now(), "YYYYMMDDhhmmss")

 こういう名前に変えているよね。

 ss までいれているので大丈夫？　いやぁ、ＶＢＡ処理で　「秒」なんてのは、結構長い時間帯。
 ということは、二つ目のコンボボックスも同じ名前に変更されようとして、」そこでエラー。

 こういうことじゃないの？

 シートごとに 1 から始まるカウンター変数を準備して、
 combo_name = "ComboBox_Mtool" & Format(Now(), "YYYYMMDDhhmmss") & その変数　としたほうがいいね。

 で、テーマとは離れるし、 ?3 の数にもよるんだけど、40列70行のセルをループさせて2800回のチェックを行うより
 FindとFindNextによる処理のほうが効率はいいと思うね。

 (ぶらっと)

ぶらっとさん

ご指摘通り　以下の通りに変更すると上手くいきました。
ただ、ペースト位置が指定したセルよりちょっと下なのですが　
これは仕方ないのでしょうか？

Sub All_Change()

 Dim sh As Worksheet
 Dim sh_now As Worksheet
 Dim dblTimer As Double
 Dim FoundCell As Range, FirstCell As Range
 Dim count3 As Integer
  count3 = 0
  count3_all = 0
Dim msg As String

  For Each sh In Worksheets
   Set sh_now = sh

   count3 = 0
    If sh.Name <> "Control_LIST" Then

        Set FoundCell = sh_now.Cells.Find(What:="henkan3")
        If FoundCell Is Nothing Then
'            MsgBox "見つかりません"
'            Exit Sub
        Else
            Set FirstCell = FoundCell
                count3 = count3 + 1
            '置き換え
            Worksheets("Control_LIST").Shapes("ComboBox_Mtool").Copy
            Application.Goto sh_now.Cells(FoundCell.Cells.Row, FoundCell.Cells.Column)
            dblTimer = CDbl(Timer)
            combo_name = "ComboBox_Mtool" + Format(Now(), "YYYYMMDDhhmmss") & Fix((dblTimer - Fix(dblTimer)) * 1000)

' combo_name = "ComboBox_Mtool" + Format(Now(), "YYYYMMDDhhmmss")

            With sh_now
                .Paste
                DoEvents        'おまじない
                .Shapes(.Shapes.Count).Name = combo_name

            End With

            Call Combo_Set(sh_now, sh_now.Shapes(sh_now.Shapes.Count).DrawingObject)

        Do
            Set FoundCell = sh_now.Cells.FindNext(FoundCell)
            If FoundCell.Address = FirstCell.Address Then
                Exit Do
            Else
                count3 = count3 + 1
                '置き換え
                Worksheets("Control_LIST").Shapes("ComboBox_Mtool").Copy
            Application.Goto sh_now.Cells(FoundCell.Cells.Row, FoundCell.Cells.Column)
                dblTimer = CDbl(Timer)
                combo_name = "ComboBox_Mtool" + Format(Now(), "YYYYMMDDhhmmss") & Fix((dblTimer - Fix(dblTimer)) * 1000)

    '                        combo_name = "ComboBox_Mtool" + Format(Now(), "YYYYMMDDhhmmss")
                With sh_now
                    .Paste
                    DoEvents        'おまじない
                    .Shapes(.Shapes.Count).Name = combo_name

                End With

                Call Combo_Set(sh_now, sh_now.Shapes(sh_now.Shapes.Count).DrawingObject)

            End If
        Loop
    End If

      End If
         count3_all = count3_all + count3
    Next
msg = "一括変換完了" & vbNewLine & "計測器変換　「" & count3_all & " 」件"

MsgBox msg

End Sub
（ケビン）

 まず、

 >Application.Goto sh_now.Cells(FoundCell.Cells.Row, FoundCell.Cells.Column)

 これは FoundCell そのものを選択するわけだから、

 Application.Goto FoundCell

 でいいんだよ。
 ただ、以下の手当てをするので、この Application.Goto そのものが不要になる。

            With sh_now
                .Paste
                DoEvents        'おまじない
                .Shapes(.Shapes.Count).Name = combo_name
            End With

 これを

    With sh_now
        .Paste
        DoEvents        'おまじない
        With .Shapes(.Shapes.Count)
            .Name = combo_name
            .Left = FoundCell.Left
            .Top = FoundCell.Top
        End With
    End With

 これでどうだろう？

 (ぶらっと)

ぶらっとさん

きれいに位置通りにペーストされました。
ありがとうございました。

（ケビン）

コメント返信：

[ 一覧(最新更新順) ]

[[20130517102716]] 『ファイル内全ての特定文字列をコントロールに置き』（ケビン） ページの最後に飛ぶ

[[20130517102716]]　『ファイル内全ての特定文字列をコントロールに置き』（ケビン）　ページの最後に飛ぶ