Office関連

[VBA]自動的にフォントサイズを調整する疑似テキストボックス

前回と同様、環境依存つながりでmougの給湯室に書いたコードを載せておきます。

'**************************************************************
'  スクロールバーが表示されるほど文字量が増えたら
'  自動的にフォントサイズを調整する疑似テキストボックスのサンプル
'
'  2015/9/9 - @kinuasa
'
'  要参照
'    Microsoft HTML Object Library
'  要配置
'    WebBrowserコントロール(WebBrowser1)(必須),
'    CommandButtonコントロール(CommandButton1)(確認用なので必須ではない)
'**************************************************************

Option Explicit

Private WithEvents HTMLTextArea As MSHTML.HTMLTextAreaElement
Private TextAreaFontSize As Long
Private Const DefaultStyle As String = "width:100%;height:100%;border:none;overflow:auto;font-family:'MS UI Gothic';" 'スタイルは好みに応じて変更

Private Sub UserForm_Initialize()
  TextAreaFontSize = 20 '初期値
  With Me.WebBrowser1
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Navigate "about:blank"
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    With .Document
      .body.Scroll = "no"
      .body.Style.cssText = "margin:0;padding:0;"
      Set HTMLTextArea = .createElement("textarea")
      HTMLTextArea.Style.cssText = DefaultStyle & "font-size:" & TextAreaFontSize & "pt;"
      .body.appendChild HTMLTextArea
    End With
  End With
End Sub

Private Sub HTMLTextArea_onkeydown()
  If TextAreaFontSize > 10 Then 'フォントサイズの最小値指定
    With HTMLTextArea
      If HTMLTextArea.offsetHeight < HTMLTextArea.ScrollHeight Then
        TextAreaFontSize = TextAreaFontSize - 2
        .Style.cssText = DefaultStyle & "font-size:" & TextAreaFontSize & "pt;"
      End If
    End With
  End If
End Sub

Private Sub CommandButton1_Click()
  With HTMLTextArea
    MsgBox .Value, vbInformation + vbSystemModal '確認用
    .Value = ""
    TextAreaFontSize = 20
    .Style.cssText = DefaultStyle & "font-size:" & TextAreaFontSize & "pt;"
  End With
End Sub

HTMLTextAreaInput_01

動きとしては面白いのですが、実際の業務で使うのはあまりオススメできません。
「こういうこともできるんだ!」と、楽しむくらいが良いと思います。

[VBA]ユーザーフォームでBootstrapを使う。前のページ

ドラッグ&ドロップした画像をクリップボードにコピーするバッチファイル次のページ

関連記事

  1. Office関連

    [Excel Services ECMAScript]ActiveWorkbookのシート数を取得す…

    埋め込んだExcelワークブックのシート数を取得するコードです。 …

  2. Office関連

    選択範囲をOneNoteに送るVBAマクロ

    OneNote プリンタードライバー(プリンター)を使ってドキュメント…

  3. Office関連

    Office 2019 Commercial Preview版のインストール方法

    「Microsoft、「Office 2019 Commercial …

  4. Office関連

    関数一覧(Excel 2013 Customer Preview)

    関数の挿入ダイアログから抽出したExcel 2013 Customer…

  5. Office関連

    [リボン・カスタマイズ]カスタムタブを共有する。

    ※ 2015/2/18 コードに一部誤りがあったので修正しました。…

  6. Office関連

    アドインやテンプレートのバージョンチェックを行うVBAマクロ

    色々なアプリケーションに実装されている、「最新バージョンの確認」機能、…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP