5
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

Excel VBAAdvent Calendar 2017

Day 19

シートを半透明に

Last updated at Posted at 2017-12-18

半透明Window

一部のテキストエディターや、疑似端末ソフトなどは、ウィンドウを半透明設定することができます。背景で何か動いているのが見えるとか、メリットはそれぞれあると思いますが、何かを参照しながら入力するときに、半透明だと、入力画面からデータが透けて見えるようなメリットがある場合もあります。

VBAでWindowを半透明化

VBAからでもWindowsのAPIを使って、Windowの透明度を変更することができます。あまり薄くすると見えにくいとか、調整が難しいのですが、特定のシートだけ半透明にするようなことができれば、もっと使い方が広がるかも!と思った次第。

まずは以下のコードを標準モジュール内に書きます。

Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal color As Long, ByVal bAlpha As Byte, ByVal alpha As Long) As Boolean

' 不透明度opacityは0(透明)から1(通常)の間
Sub SetOpacity(opacity As Double)

    On Error GoTo DoNothing
 
    Dim h As Long
    Dim attr As Long
 
    h = Application.hwnd
    attr = GetWindowLong(h, GWL_EXSTYLE)
    SetWindowLong h, GWL_EXSTYLE, attr Or WS_EX_LAYERED
    
    SetLayeredWindowAttributes h, RGB(0, 0, 0), CByte(opacity * 255), LWA_ALPHA
 
DoNothing:
 
End Sub

使い方は簡単で、引数に0から1の間の数値を渡すだけです。0.5を渡せばちょうど半分透明になり、0.7ならそれより濃く、0.3ならそれより薄く表示されます。

シートごとに透明度を指定

シートごとにopacityという名前を定義して、ブック(ThisWorkbook)に以下のコードを入れると、シートを切り替えるごとに、それぞれのシートのセル(%フォーマットにしておくのが良いですね)に書かれた不透明度が自動設定されます。

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    On Error GoTo Opac
    SetOpacity Evaluate("opacity")
    Exit Sub
Opac:
    SetOpacity 1
End Sub

opacityの名前を設定していないシートは自動的に100%になるので、半透明化したいシートだけ、opacityを定義しておけば良いようになっています。

実行例

Sheet1を50%、Sheet2を75%、Sheet3を90%、Sheet4/Sheet5は設定なしとした実行例です。
translucent.gif

シート範囲の名前をまとめて定義

名前はそれぞれのシートに定義しても良いし、各シート範囲のopacityを別シートに一括設定するのも、ひとつの方法です。

文章で言ってもわかりにくいので、すべてのシートを80%透明度として一覧のopacityシートを作成するVBAコードを最後に書いておきます。シートごとの範囲名って、別シートに定義できるんですね。

Sub CreateOpacityList()
    Dim sheet As Worksheet
    On Error Resume Next
    Set sheet = Worksheets("opacity")
    If sheet Is Nothing Then
        ' opacityシートがなければブックの最後に追加する
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        Set sheet = ActiveSheet
        sheet.Name = "opacity"
    End If
    ' 1行目は見出し
    sheet.Range("A1").Value = "シート名"
    sheet.Range("B1").Value = "不透明度"
    Dim cell As Range
    Set cell = sheet.Range("A2")
    For Each sheet In Worksheets
        If sheet.Name <> "opacity" Then
            cell.Value = sheet.Name
            With cell.Offset(0, 1)
                .Value = 0.8
                .Style = "Percent"
            End With
            sheet.Names.Add Name:="opacity", RefersTo:=cell.Offset(0, 1)
            Set cell = cell.Offset(1, 0)
        End If
    Next
End Sub

上記コードを実行して生成されたopacityシートには、シート名ごとに80%と書かれているので、この値を変更することで、シートごとの不透明度を設定することができます。

5
6
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
5
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?