[[20080726141927]]　『入力規則ドロップダウンリストの幅変更』（MAKO）　ページの最後に飛ぶ

『入力規則ドロップダウンリストの幅変更』（MAKO）

 いつも皆様に大変お世話になっております。

 印刷時のスペースの問題で、縦に[A26:A37]でセル結合して(入力が横文字なもので)、 
 書式設定の配置-文字列を90度にし、そこに入力規則のドロップダウンリストを適用
 させたいのですが、
 A列は列幅2ポイントしかなく、ドロップダウンリストの幅が狭いために、選択ができません。

 全文検索にて、同様の質問＆回答をいろいろ見せていただき、幅を広げることはVBAで可能のようですが、
　 
[[20050223121323]] 『ドロップダウンリストの幅を変更』(maru) のなかで
 川野鮎太郎さんが提示されてたコード、

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim s As Shape
 Dim BtnWidth As Single
 Dim MyName As String

 On Error Resume Next
 MyName = ActiveSheet.Shapes(1).Name
    With ActiveCell
        Select Case (.Row >= 26) * (.Row <= 37) * (.Column = 1)
        Case True
            If .Validation.Type = xlValidateList Then
                Set s = ActiveSheet.Shapes(MyName)
                BtnWidth = s.Width - .Width
                s.Width = 150
                s.Left = .Left + .Width - s.Width + BtnWidth
                Set s = Nothing
                '自動表示をしたくない場合はSendKeys　"%{down}"　を削除してください。
                SendKeys "%{down}"
            End If
        End Select
    End With
 End Sub

 を入れたのですが、リストの幅は変わりません。

 しかし、セルを選択すると、リストが自動表示されますし、よくよく見ると、
 なぜか同じ書式上の オートシェイプで貼り付けた「○」の横幅が1.5倍になってました!
 どなたか、原因のわかる方おられますでしょうか？

 こちらでMAKOさんの仰る現象が再現できないので原因が分かりません。
 もしも差し支えなければ、そのファイルを見せていただければありがたいんですけどね。
 もちろん差しさわりのあるデータは削除したファイルでかまいません。
 データのアップは、以下のようなことで可能です。
以前に紹介したものですので、現在は若干変更になってるかもしれません。
http://skyblue123.hp.infoseek.co.jp/Excel/YahooBc.html

 （川野鮎太郎）

 A26がアクティブに成っている状態で、選択している
 なんて事では無いのですかね？

 一度別のセルを選択した後、再度A26を選択してみても
 「▼」はB列に出るのでしょうか？

 (HANA)

 1.新規ブックを開く
 2.[挿入]→[図]→[オートシェイプ]で丸いやつを貼り付ける
 3.上のマクロをコピペする
 4.セルA26を選択
 こんな感じで再現できると思います。

 >MyName = ActiveSheet.Shapes(1).Name
 このあたりがポイントなのかな？　(アカギ)

 すいません、返事が遅くなりました。みなさんコメントありがとうございます。

 作成中の書式自体は会社に置いて来てしまったのですが、
 アカギさんからのコメントのように、家のＰＣでテストしてみたところ、
 オートシェイプの図形が貼り付けてある場合のみ、最初のコメントのような現象が起きるようです。

 図形をはずすと、ちゃんとリストの幅が広がることも判明しました。

 実は、川野鮎太郎さんのコードにたどり着く前に

 [[20040211174043]]『簡易リストボックスの幅を拡大』（おれおれ）
 のなかで、りなさんの紹介されているコードを試してみたのですが、

 イミディエイトウィンドウで?activesheet.shapes(1).nameを試してみたら、
 「Drop Down」がでずに、その時はたしか「Line 1」（Excel 2003）とかしか出なかったので、
 （今から考えると、他にもオートシェイプで線を張り付けていたのでそのことだったのですね）
 他をいろいろ探していて、川野鮎太郎さんのコードにたどり着いた次第です。

 Excel 2007だと、同様にイミディエイトウィンドウで調べると、
 貼り付けた順？に認識されるのか「直線コネクタ 4」とか「円／楕円 5」とか出ます。

 オートシェイプの図形を張り付けていても、ドロップダウンリストを認識させて、リストの幅だけ広げる
 方法はあるのでしょうか？　みなさんお知恵を貸して下さい。

 (MAKO)

 Shapeのほうから攻めていって見るのはどうでしょう。

 '------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MyShape As Shape
    If Target.Address(0, 0) = "A26:A37" Then
        For Each MyShape In ActiveSheet.Shapes
            With MyShape
                If .Top = Target.Top And .Left = Target.Left Then
                    .Width = 150
                End If
            End With
        Next
    End If
End Sub
 '------

 (HANA)

 HANAさん、いつもありがとうございます。

 ご提示いただいたコードにて解決しました!!
 今後の参考までに、お伺いしたいのですが、

 今回作成の書式については、対象になる入力規則を入れたセル（セル幅の狭い）は、
 ２箇所だけだったので、ご提示のコードをいろいろ試して、

    If Target.Address(0, 0) = "A26:A37" Then
        For Each MyShape In ActiveSheet.Shapes
            With MyShape
                If .Top = Target.Top And .Left = Target.Left Then
                    .Width = 150
                End If
            End With
        Next
    End If

 の部分を、アドレスを変えて２回繰り返して入れて、事なきを得たのですが、
 対象のセルが多数にわたるとき、もっと簡単な方法はありますでしょうか？

 (MAKO)

 こんなので大丈夫ですか？

 '------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MyShape As Shape, Rng As String, MyRng
Rng = "A26:A37,M13:M24"     '←★ここに範囲を追加
    For Each MyRng In Split(Rng, ",")
        If Target.Address(0, 0) = MyRng Then
            For Each MyShape In ActiveSheet.Shapes
                With MyShape
                    If .Top = Target.Top And .Left = Target.Left Then
                        .Width = 150
                        Exit Sub    '一つ変更したら終了
                    End If
                End With
            Next
        End If
    Next
End Sub
 '------

 (HANA)

 HANAさん、ありがとうございました!!
 今後とも、ご指導よろしくお願いいたします!

 (MAKO)

コメント返信：

[ 一覧(最新更新順) ]

[[20080726141927]] 『入力規則 ドロップダウンリストの幅変更』（MAKO） ページの最後に飛ぶ

[[20080726141927]]　『入力規則ドロップダウンリストの幅変更』（MAKO）　ページの最後に飛ぶ