HOME > エクセルVBA > サンプル > GetSystemPowerStatus

GetSystemPowerStatus


【ファイル名】GetSystemPowerStatus.xlsm
【バージョン】Ver 1.0.0.1
【作成日】2021年05月05日
【更新日】2021年05月10日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】GetSystemPowerStatus.zip
【説明】Windows APIのGetSystemPowerStatusを使用したバッテリーの状態を表示するサンプルです。

バッテリーの状態の画面

【外部リンク】Windows > Apps > Win32 > API > System Services > Winbase.h > GetSystemPowerStatus function
【外部リンク】Windows > Apps > Win32 > API > System Services > Winbase.h > SYSTEM_POWER_STATUS structure

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="バッテリーの状態">
          <button id="ShowFormButton" label="フォームを表示(&amp;S)" supertip="フォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

UserForm1
Option Explicit

' https://docs.microsoft.com/en-us/windows/win32/api/winbase/ns-winbase-system_power_status
  Private Type SYSTEM_POWER_STATUS ' winbase.h
    ACLineStatus        As Byte  ' AC電源 0:未接続 1:接続中 255:不明
    BatteryFlag         As Byte  ' バッテリーの状態 1:高い 2:低い 4:非常に低い 8:充電中 128:バッテリーなし 255:不明
    BatteryLifePercent  As Byte  '
    Reserved1           As Byte  '
    BatteryLifeTime     As Long  ' バッテリーの残量    -1:不明
    BatteryFullLifeTime As Long  ' バッテリーが満タン  -1:不明
  End Type

#If Win64 Then
' https://docs.microsoft.com/ja-jp/windows/win32/api/winbase/nf-winbase-getsystempowerstatus
  Private Declare PtrSafe Function GetSystemPowerStatus Lib "kernel32" (ByRef lpSystemPowerStatus As SYSTEM_POWER_STATUS) As Long

#Else
  Private Declare Function GetSystemPowerStatus Lib "kernel32" (ByRef lpSystemPowerStatus As SYSTEM_POWER_STATUS) As Long
#End If

' バッテリーの状態を取得する
Private Sub CommandButton1_Click()
  Dim lpSystemPowerStatus As SYSTEM_POWER_STATUS
  Dim str As String
  
  Call GetSystemPowerStatus(lpSystemPowerStatus)
  
  str = ""
  With lpSystemPowerStatus
    str = str & "ACLineStatus = " & .ACLineStatus & vbCrLf
    str = str & "BatteryFlag = " & .BatteryFlag & vbCrLf
    str = str & "BatteryLifePercent = " & .BatteryLifePercent & vbCrLf
    str = str & "BatteryLifeTime = " & .BatteryLifeTime & vbCrLf
    str = str & "BatteryFullLifeTime = " & .BatteryFullLifeTime & vbCrLf
  End With
  
  RefEdit1.Text = str
  RefEdit1.SelStart = 0
  RefEdit1.SelLength = 0
End Sub

Private Sub ExitButton_Click()
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  CommandButton1_Click
End Sub
このページの上

Module1
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "ShowFormButton"
      UserForm1.Show vbModal
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  
  Exit Sub
'
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub
このページの上