VBA - 画面の明るさを自動的に増減する

2024-7-9 • tag-icon

問題：

ノートパソコンの画面の明るさがランダムに低下し、その後ゆっくりと増加します。これは、ユーザーフォームをフェードインおよびフェードアウトするマクロを使用してから発生しています。

私はそのマクロを使用したことを後悔し、数週間前にそのマクロを削除しました。

しかし、その時から、ノートパソコンの画面の明るさがオンとオフを繰り返すようになり、私が何も操作していないのに突然暗くなり、その後ゆっくりと急に明るくなるようになりました。

すでに削除しました色あせ大きい！

さて、私の質問は、ノートパソコンの画面の明るさを永続的に最大化するにはどうしたらよいかということです。これは、色あせ数週間前に使用したマクロです。

どうすればいいでしょうか、明るさを永続的に上げるために別の VBA を書くのでしょうか?

これをどうすれば修正できますか?

以下は私が使用したマクロコードですが、すでに削除しました。使用したことを後悔しています。リンクとコードは以下です。

https://wellsr.com/vba/2018/excel/vba-fade-userform-in-and-out/

'PLACE IN YOUR USERFORM CODE
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As LongPtr, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long 
#Else
Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" ( _
    ByVal hwnd As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
                ByVal hwnd As Long, _
                ByVal crKey As Long, _
                ByVal bAlpha As Byte, _
                ByVal dwFlags As Long) As Long

#End If
'Constants for title bar
Private Const GWL_STYLE As Long = (-16)           'The offset of a window's style
Private Const GWL_EXSTYLE As Long = (-20)         'The offset of a window's extended style
Private Const WS_CAPTION As Long = &HC00000

'Style to add a titlebar
Private Const WS_EX_DLGMODALFRAME As Long = &H1   'Controls if the window has an icon

'Constants for transparency
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1                  'Chroma key for fading a certain color on your Form
Private Const LWA_ALPHA = &H2                     'Only needed if you want to fade the entire userform

'sleep
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64-Bit versions of Excel
    Dim formhandle As LongPtr
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32-Bit versions of Excel
    Dim formhandle As Long
#End If

Private Sub UserForm_Initialize()
'force the form to fully transparent before it even loads
formhandle = FindWindow(vbNullString, Me.Caption)
SetWindowLong formhandle, GWL_EXSTYLE, GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
SetOpacity (0)
End Sub

Private Sub UserForm_Activate()
'HideTitleBarAndBorder Me 'hide the titlebar and border
FadeUserform Me, True 'Fade your userform in
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
FadeUserform Me, False 'Fade your userform in
End Sub

Sub FadeUserform(frm As Object, Optional FadeIn As Boolean = True)
'Defaults to fade your userform in.
'Set the 2nd argument to False to Fade Out.
Dim iOpacity As Integer

formhandle = FindWindow(vbNullString, Me.Caption)

SetWindowLong formhandle, GWL_EXSTYLE, GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
'The following line sets the userform opacity equal to whatever value you have in iOpacity (0 to 255).
If FadeIn = True Then 'fade in
    For iOpacity = 0 To 255 Step 15
        Call SetOpacity(iOpacity)
    Next
Else 'fade out
    For iOpacity = 255 To 0 Step -15
        Call SetOpacity(iOpacity)
    Next
    Unload Me 'unload form once faded out
End If
End Sub

Sub SetOpacity(Opacity As Integer)
        SetLayeredWindowAttributes formhandle, Me.BackColor, Opacity, LWA_ALPHA
        Me.Repaint
Sleep 50
End Sub

Sub HideTitleBarAndBorder(frm As Object)
'Hide title bar and border around userform
'Source: https://wellsr.com/vba/2017/excel/remove-window-border-title-bar-around-userform-vba/
#If VBA7 Then
    Dim lngWindow As LongPtr
    Dim lFrmHdl As LongPtr
#Else
    Dim lngWindow As Long
    Dim lFrmHdl As Long
#End If
    lFrmHdl = FindWindow(vbNullString, frm.Caption)
'Build window and set window until you remove the caption, title bar and frame around the window
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    SetWindowLong lFrmHdl, GWL_STYLE, lngWindow
    lngWindow = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
    lngWindow = lngWindow And Not WS_EX_DLGMODALFRAME
    SetWindowLong lFrmHdl, GWL_EXSTYLE, lngWindow
    DrawMenuBar lFrmHdl
 End Sub

(以下の AppleOddity と HarryMC の助けにより解決しました... 本当にありがとうございます!!)。添付のスクリーンショットの解決方法では、次の 3 つの点を確認します。

ディスプレイの明るさが有効になっているので、無効にする必要があります（「オフ」にします）。
ディスプレイの明るさが暗く、100%に設定する必要があります
ディスプレイの明るさを100%に設定する必要があります

あなたたちは素晴らしいです!! このウェブサイト StackExchange が大好きです!!

関連情報