vbaの質問です。

  excel sheetに ActiveXのテキストボックスを作り、
  そのテキストボックスと excel sheet上のcellとリンクさせる
これを、手動でできます。
なお、ユーザフォームにテキストボックスを作るのではなくて、
  エクセルシート上で、テキストボックスとリンク先のcellは
  同居します。 
これを、VBAで実現したいのです。

次のコードでテキストボックスは作れるのですが、Cellにリンクを
VBAで貼る方法がわかりません。 どうすれば良いでしょうか。
Sub macroG()
Dim i As Integer
Set mySht = ActiveSheet
On Error Resume Next
For i = 1 To 4
Set myShp1 = mySht.OLEObjects.Add(ClassType:= _
"Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=360, Top:=75 + 48 * i, Width:=180, Height:=36)
With myShp1
.Name = "SA" & CStr(i)
End With
Next i
Set myShp1 = Nothing: Set mySht = Nothing
End Sub

実際には、エクセルシートの条件をVBAで読み取って、シート上に
コントロールの位置、サイズ、リンク先を決定しながら、コントロールを
VBAで自動配置したいので、ユーザフォームは使いたくありません。
リンク先のCellと情報を双方向にしたいので、リンクを貼りたいのです。

回答の条件
  • 1人5回まで
  • 登録:2008/06/26 11:35:06
  • 終了:2008/06/26 16:53:12

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/06/26 13:05:03

ポイント200pt

見当違いな回答でしたら住みません。

Sub macroG()
    Dim i As Integer
    Set mySht = ActiveSheet
    On Error Resume Next
    For i = 1 To 4
        Set myShp1 = mySht.OLEObjects.Add(ClassType:= _
        "Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, _
        Left:=360, Top:=75 + 48 * i, Width:=180, Height:=36)
        With myShp1
            .Name = "SA" & CStr(i)
            .LinkedCell = "A" & i    '★★★ セルとのリンクを設定
        End With
    Next i
    Set myShp1 = Nothing: Set mySht = Nothing
End Sub

ということでしょうか。

http://www.geocities.jp/happy_ngi/YNxv98316.html

id:hathi

Mookさん ありがとうございます。

 回答頂いたことのねらいは、私の思っていることです。

 ただし、このコードでは、私のPCでは、ねらいが実現しません。

With myShp1

.Name = "SA" & CStr(i)  '★ オブジェクト名が設定できない

.LinkedCell = "A" & i '★ セルとのリンク設定ができない

End With

 位置、サイズは設定できるのですが、valueやLinkedCell、MultiLine

 などのプロパティが設定できないのです。

 もちろん このコードの実行が完了した後で、手動でプロパティを

 設定すればそれはできます。 VBAでこれを設定したいのです。

2008/06/26 14:11:07
  • id:Mook
    うーん、なぜでしょうね。
    こちらでは問題なく動作したのですが。

    ステップ実行でやるとエラーになるというのはあるのですが、実行してもダメでしたか?

    ただ確認したのが2007でしたので、2003でも確認してみます。
  • id:Mook
    2003 でも動作確認できました。

    ご使用のバージョンはいくつですか?
    また、どのように実行しているでしょうか。
  • id:hathi
    Mookさん  
      大変に申し訳ありません。 
      原因が 1つはわかりました。

      私が、Dim myShp1 as Shape としていました。
         Dim myShp1 as Object になおしたら、
       リンクや オブジェクト名の設定はできました。
     
      しかし、現在、下記のコードで、
       オブジェクト名、リンク先Cellは設定できているのですが、
       フォントサイズや、マルチラインが設定できていません。
       これはなぜでしょうか?

    Sub macroG()
    Set mySht = ActiveSheet
    On Error Resume Next
    For i = 1 To 4
    Set myShp1 = mySht.OLEObjects.Add(ClassType:= _
    "Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, _
    Left:=360, Top:=75 + 48 * i, Width:=180, Height:=36)
    With myShp1
    .Name = "SA" & CStr(i)
    .LinkedCell = "A" & i
    .TextFrame.Characters.Font.Size = 12
    .MultiLine = True
    End With
    Next i
    Set myShp1 = Nothing: Set mySht = Nothing
    End Sub
  • id:Mook
    とりあえず、下記でできるようです。

    Sub macroG2()
      Dim mySht As Worksheet
      Set mySht = ActiveSheet

      Dim i As Long
      Dim myShp As Object
      For i = 1 To 4
        Set myShp = mySht.OLEObjects.Add(ClassType:= _
        "Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, _
        Left:=360, Top:=75 + 48 * i, Width:=180, Height:=36)
        With myShp
          .Name = "SA" & CStr(i)
          .LinkedCell = "A" & i
          .Object.FontSize = 32
          .Object.MultiLine = True
        End With
      Next i
      Set myShp = Nothing
      Set mySht = Nothing
    End Sub
  • id:hathi
    Mookさん

      大変にありがとうございました。

      おかげさまで、解決できました。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません