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





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, 




Inline image 1

Nenhum comentário:

Postar um comentário

diHITT - Notícias