VBA Excel - Funções com informações de Memória não estão disponíveis na versão MS Excel 2007 - Memory functions unavailable in Excel 2007

Termo de Responsabilidade

Nas anteriores versões do MS Excel as funções abaixo estavam disponíveis:

Application.MemoryFree 

Application.MemoryTotal 

Application.MemoryUsed 

Mas na versão do MS Excel 2007 elas disapareceram. Mas nem tudo está perdido, a função GlobalMemoryStatus pode ser usada, e está disponível como função API do Windows:

Iniciar o Microsoft Excel e crie uma nova pasta de trabalho.

No menu Ferramentas , aponte para macro e em seguida, clique em Editor do Visual Basic (ou pressione ALT+F11).

No menu Inserir , clique em módulo .

Na folha de módulo, digite o seguinte código:  

Option Explicit

Type SYSTEM_INFO

    dwOemID As Long

    dwPageSize As Long

    lpMinimumApplicationAddress As Long

    lpMaximumApplicationAddress As Long

    dwActiveProcessorMask As Long

    dwNumberOrfProcessors As Long

    dwProcessorType As Long

    dwAllocationGranularity As Long

    dwReserved As Long

End Type

Type OSVERSIONINFO

    dwOSVersionInfoSize As Long

    dwMajorVersion As Long

    dwMinorVersion As Long

    dwBuildNumber As Long

    dwPlatformId As Long

    szCSDVersion As String * 128

End Type

Type MEMORYSTATUS

    dwLength As Long

    dwMemoryLoad As Long

    dwTotalPhys As Long

    dwAvailPhys As Long

    dwTotalPageFile As Long

    dwAvailPageFile As Long

    dwTotalVirtual As Long

    dwAvailVirtual As Long

End Type

'The following three Declare lines must be each entered on a single

'line.

Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

             (LpVersionInformation As OSVERSIONINFO) As Long

Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As _

            MEMORYSTATUS)

Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As _

              SYSTEM_INFO)

Public Const PROCESSOR_INTEL_386 = 386

Public Const PROCESSOR_INTEL_486 = 486

Public Const PROCESSOR_INTEL_PENTIUM = 586

Public Const PROCESSOR_MIPS_R4000 = 4000

Public Const PROCESSOR_ALPHA_21064 = 21064

Sub SystemInformation()

Dim msg As String         ' Status information.

Dim NewLine As String     ' New-line.

Dim ret As Integer        ' OS Information

Dim ver_major As Integer  ' OS Version

Dim ver_minor As Integer  ' Minor Os Version

Dim Build As Long         ' OS Build

      NewLine = Chr(13) + Chr(10)  ' New-line.

      ' Get operating system and version.

      Dim verinfo As OSVERSIONINFO

      verinfo.dwOSVersionInfoSize = Len(verinfo)

      ret = GetVersionEx(verinfo)

      If ret = 0 Then

          MsgBox "Error Getting Version Information"

          End

      End If

      Select Case verinfo.dwPlatformId

          Case 0

              msg = msg + "Windows 32s "

          Case 1

              msg = msg + "Windows 95/98 "

          Case 2

              msg = msg + "Windows NT/2000 "

      End Select

      ver_major = verinfo.dwMajorVersion

      ver_minor = verinfo.dwMinorVersion

      Build = verinfo.dwBuildNumber

      msg = msg & ver_major & "." & ver_minor

      msg = msg & " (Build " & Build & ")" & NewLine & NewLine

      ' Get CPU type and operating mode.

      Dim sysinfo As SYSTEM_INFO

      GetSystemInfo sysinfo

      msg = msg + "CPU: "

      Select Case sysinfo.dwProcessorType

          Case PROCESSOR_INTEL_386

              msg = msg + "Intel 386" + NewLine

          Case PROCESSOR_INTEL_486

              msg = msg + "Intel 486" + NewLine

          Case PROCESSOR_INTEL_PENTIUM

              msg = msg + "Intel Pentium" + NewLine

          Case PROCESSOR_MIPS_R4000

              msg = msg + "MIPS R4000" + NewLine

          Case PROCESSOR_ALPHA_21064

              msg = msg + "DEC Alpha 21064" + NewLine

          Case Else

              msg = msg + "(unknown)" + NewLine

      End Select

      msg = msg + NewLine

      ' Get free memory.

      Dim memsts As MEMORYSTATUS

      Dim memory As Long

      GlobalMemoryStatus memsts

      memory = memsts.dwTotalPhys

      msg = msg + "Total Physical Memory: "

      msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine

      memory = memsts.dwAvailPhys

      msg = msg + "Available Physical Memory: "

      msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine

      memory = memsts.dwTotalVirtual

      msg = msg + "Total Virtual Memory: "

      msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine

      memory = memsts.dwAvailVirtual

      msg = msg + "Available Virtual Memory: "

      msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine

      MsgBox msg, vbOKOnly, "System Info"

End Sub

No menu Ferramentas , aponte para macro e, em seguida, clique em macros .

Clique em SystemInformation e, em seguida, clique em Executar .

Reference::Gerrit-Jan Linker

212536 OFF2000: Como executar o código de exemplo de artigos da Knowledge Base

161151 COMO: Obter informações de status do Windows por meio de chamadas de API

189249 COMO: Determinar qual versão do Windows de 32 bits está sendo usado

Tags: VBA, Excel, Memory, memória,  Excel 2007, API, Windows,