我有这个vba代码,它将物理内存数据复制到一个特定的Excel工作表,工作正常, 但是我想让它变得通用,每当我调用这个函数我想将数据复制到不同的范围
Sub PhysicalMemWMI()
Dim dTotalMemory As Double
Dim dAvailable As Double
Dim dFreeMem As Double
sWQL = "SELECT * FROM Win32_OperatingSystem"
Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
With ThisWorkbook.Sheets("Physical Memory")
For Each oWMIObjEx In oWMIObjSet
dTotalMemory = dTotalMemory + oWMIObjEx.TotalVisibleMemorySize
Next
dTotalMemory = dTotalMemory / 1024
Set colItems = oWMISrvEx.ExecQuery("Select * from Win32_PerfFormattedData_PerfOS_Memory", , 48)
For Each objitem In colItems
dFreeMem = dFreeMem + objitem.FreeAndZeroPageListBytes
dAvailable = dAvailable + objitem.AvailableBytes
Next objitem
dFreeMem = dFreeMem / 1024 / 1024
.Range("A2:B2").Value2 = Array(Format(((dTotalMemory * 1024 * 1024) - dAvailable) / 1024 / 1024 / 1024, "#,##0.00 GB"), Format(dFreeMem, "#,##0 MB"))
End With
End Sub
答案 0 :(得分:0)
只需在子资源中添加一个参数:
Option Explicit
Sub test()
PhysicalMemWMI ActiveSheet.Range("A1")
End Sub
Sub PhysicalMemWMI(destinationRange As Range)
Dim dTotalMemory As Double
Dim dAvailable As Double
Dim dFreeMem As Double
sWQL = "SELECT * FROM Win32_OperatingSystem"
Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
For Each oWMIObjEx In oWMIObjSet
dTotalMemory = dTotalMemory + oWMIObjEx.TotalVisibleMemorySize
Next
dTotalMemory = dTotalMemory / 1024
Set colItems = oWMISrvEx.ExecQuery("Select * " & _
"from Win32_PerfFormattedData_PerfOS_Memory", , 48)
For Each objitem In colItems
dFreeMem = dFreeMem + objitem.FreeAndZeroPageListBytes
dAvailable = dAvailable + objitem.AvailableBytes
Next objitem
dFreeMem = dFreeMem / 1024 / 1024
destinationRange.Value2 = Array( _
Format( _
((dTotalMemory * 1024 * 1024) - dAvailable) _
/ 1024 / 1024 / 1024, _
"#,##0.00 GB"), Format(dFreeMem, "#,##0 MB"))
End Sub
注意:由于您只使用destinationRange
一次,因此此处不需要With
条款。
(上面未经测试的代码,但它应该有效。)