Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


36963 / 76738 ←次へ | 前へ→

【44949】Re:テキストボックスを
発言  ichinose  - 06/12/7(木) 19:35 -

引用なし
パスワード
   ▼珠ちゃん(素人です) さん:
こんばんは。

>セルをクリックすると、テキストボックスが出てきてセル内容を大きく見たい。
クリックではなく、ダブルクリックで

>テキストボックスが出てきてセル内容を大きく見たい。

という仕様にしましょう!!

Thisworkbookのモジュールに
'=============================================================
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Const tnm = "__txt"
  Dim wk1 As Variant
  Dim wk2 As Variant
  Dim txt As TextBox
  On Error Resume Next
  
  If Target.Count = 1 Then
    Set txt = Sh.TextBoxes(tnm)
    If Err.Number <> 0 Then
     With Target
       Set txt = Sh.TextBoxes.Add(.Left, .Top, .Width, .Height)
       End With
     End If
    With Target
     txt.Visible = True
     txt.Formula = "=" & .Address
     txt.Name = tnm
     txt.Left = .Left
     txt.Top = .Top
     txt.Width = .Width * 3
     txt.Height = .Height * 3
     txt.Font.Name = .Font.Name
     txt.Font.Size = .Font.Size * 3
     End With
    txt.Select
    Err.Clear
    Do
     wk1 = TypeName(Selection)
     wk2 = Selection.Name
     If Err.Number <> 0 Then Exit Do
     If txt.Name <> wk2 Or wk1 <> "TextBox" Then Exit Do
     DoEvents
     Loop
    txt.Visible = False
   End If
  Cancel = True
End Sub

これで、任意の値の入っているセルをダブルクリックしてみてください。

セルの内容が描画のテキストボックスにて拡大表示されます。
他のセルを選択したタイミングでテキストボックスは消えます。

厳密にはいくつか問題点もありますが、
トレースしてコードの意味を理解してみてください。
0 hits

【44937】テキストボックスを 珠ちゃん(素人です) 06/12/7(木) 13:51 質問
【44938】Re:テキストボックスを neptune 06/12/7(木) 15:27 回答
【44949】Re:テキストボックスを ichinose 06/12/7(木) 19:35 発言

36963 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free