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

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

関連記事

  1. Office関連

    Wordのテンプレートをインストールするスクリプト

    Wordマクロをテンプレートにして使用する場合、通常そのテンプレートフ…

  2. Office関連

    [リボン・カスタマイズ]ユーザー名により表示するメニューを切り替える。

    今回はリボンをカスタマイズして、ファイルを開いたユーザー名によって表示…

  3. Office関連

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

  4. Office関連

    Office 2016関連資料のリンク(2)

    「Office 2016関連資料のリンク」では主にサポートサイトのリン…

  5. Office関連

    埋め込んだブックへのユーザー入力を活用する

    「Excel Web Appのブック埋め込みを試してみました。」でEx…

  6. Office アドイン

    [Office用アプリ]JavaScript API for Office ライブラリ v1.1

    2014/01/24 追加記事を書きました。・JavaScript…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP