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

GlobalMemoryStatusEx


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

メモリの情報の画面

【外部リンク】Windows > Apps > Win32 > API > System Services > Sysinfoap.h > GlobalMemoryStatusEx function
【外部リンク】Windows > Apps > Win32 > API > System Services > Sysinfoap.h > MEMORYSTATUSEX 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

#If Win64 Then
' https://docs.microsoft.com/en-us/windows/win32/api/sysinfoapi/ns-sysinfoapi-memorystatusex
  Private Type MEMORYSTATUSEX
    dwLength As Long ' このユーザー定義型のサイズ
    dwMemoryLoad As Long    ' メモリの使用率
    ullTotalPhys As LongPtr ' 物理メモリの搭載容量
    ullAvailPhys As LongPtr ' 物理メモリの空き容量
    ullTotalPageFile As LongPtr ' ページングの搭載容量
    ullAvailPageFile As LongPtr ' ページングの空き容量
    ullTotalVirtual As LongPtr ' 仮想メモリの搭載容量
    ullAvailVirtual As LongPtr ' 仮想メモリの空き容量
    ullAvailExtendedVirtual As LongPtr ' 仮想メモリの拡張空き容量
  End Type
  
' https://docs.microsoft.com/en-us/windows/win32/api/sysinfoapi/nf-sysinfoapi-globalmemorystatusex
  Private Declare PtrSafe Sub GlobalMemoryStatusEx Lib "kernel32" (lpBuffer As MEMORYSTATUSEX)
' GlobalMemoryStatusはオーバーフローするので、GlobalMemoryStatusExを使います。

#Else
  Private Type MEMORYSTATUSEX
    dwLength As Long
    dwMemoryLoad As Long
    ullTotalPhys As Currency
    ullAvailPhys As Currency
    ullTotalPageFile As Currency
    ullAvailPageFile As Currency
    ullTotalVirtual As Currency
    ullAvailVirtual As Currency
    ullAvailExtendedVirtual As Currency
  End Type
  
  Private Declare Sub GlobalMemoryStatusEx Lib "kernel32" (lpBuffer As MEMORYSTATUSEX)
#End If

' メモリの情報を取得する
Private Sub CommandButton1_Click()
  Dim lpBuffer As MEMORYSTATUSEX
  Dim str As String
  
  lpBuffer.dwLength = Len(lpBuffer)
  Call GlobalMemoryStatusEx(lpBuffer)
  
  str = ""
  With lpBuffer
    str = str & "dwMemoryLoad = " & .dwMemoryLoad & "%" & vbCrLf
    str = str & "ullTotalPhys = " & Format(.ullTotalPhys, "#,##0") & vbCrLf
    str = str & "ullAvailPhys = " & Format(.ullAvailPhys, "#,##0") & vbCrLf
    str = str & "ullTotalPageFile = " & Format(.ullTotalPageFile, "#,##0") & vbCrLf
    str = str & "ullAvailPageFile = " & Format(.ullAvailPageFile, "#,##0") & vbCrLf
    str = str & "ullTotalVirtual = " & Format(.ullTotalVirtual, "#,##0") & vbCrLf
    str = str & "ullAvailVirtual = " & Format(.ullAvailVirtual, "#,##0") & vbCrLf
    str = str & "ullAvailExtendedVirtual = " & Format(.ullAvailExtendedVirtual, "#,##0") & 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
このページの上