Lấy thông số cpu của máy tính ra một cell trong sheet (1 người xem)

mitomcombui · 21/4/11

Chào mọi người, mình có một bài toán thế này: Mình cần lấy thông số CPU của máy tính ra một ô trong 1 sheet chỉ bằng 1 cái click chuột ngay trên Nút bấm(có chứa đường link) trong sheet đó hoặc sheet khác. Mình đã lấy được thông số CPU rồi nhưng là một form hiển thị độc lập so với sheet đó. Vấn đề bây giờ là chuyển các thông số đó vào một ô cụ thể.
Đây là file mình đã lấy được thông số CPU: View attachment Book1.xls
Nhờ mọi người giúp đỡ. Cảm ơn nhiều!!!

viehoai · 21/4/11

mitomcombui đã viết:
Chào mọi người, mình có một bài toán thế này: Mình cần lấy thông số CPU của máy tính ra một ô trong 1 sheet chỉ bằng 1 cái click chuột ngay trên Nút bấm(có chứa đường link) trong sheet đó hoặc sheet khác. Mình đã lấy được thông số CPU rồi nhưng là một form hiển thị độc lập so với sheet đó. Vấn đề bây giờ là chuyển các thông số đó vào một ô cụ thể.
Đây là file mình đã lấy được thông số CPU: View attachment 61679
Nhờ mọi người giúp đỡ. Cảm ơn nhiều!!!

Vào một ô cụ thể : là vào một cell bảng tính? Nếu thế thì Code trong Sheet của bạn có lệnh

PHP:

 MsgBox "Processor Id: " & objItem.ProcessorId

sửa lại

PHP:

 Range("A1").Value = objItem.ProcessorId

..................................
Nghĩ cũng lạ bạn làm được code như vậy mà không xuất ra được bảng tính ??? ==> Mình hiểu sai ý chăng?

mitomcombui · 21/4/11

Bạn không hiểu sai ý mình đâu.Cảm ơn bạn nhé!
Còn một phần nữa là làm sao để mình chỉ cần click chuột vào 1 nút hoặc một chữ gì đó thì nó hiện ra sheet chứa ô đó chứ không phải vào: Tools/Macro/Sheet2.GetCPUID/Run nữa (Cái này có vẻ khó hơn).
Nhờ mọi người giúp đỡ.Thanks!

nghiaphuc · 21/4/11

mitomcombui đã viết:
Bạn không hiểu sai ý mình đâu.Cảm ơn bạn nhé!
Còn một phần nữa là làm sao để mình chỉ cần click chuột vào 1 nút hoặc một chữ gì đó thì nó hiện ra sheet chứa ô đó chứ không phải vào: Tools/Macro/Sheet2.GetCPUID/Run nữa (Cái này có vẻ khó hơn).
Nhờ mọi người giúp đỡ.Thanks!

- Trước hết, bạn nên di chuyển Sub GetCPUID vào Module1, không nên để ở Sheet1 hoặc ThisWorkbook.
- Kế tiếp, bạn nhấn Alt+F8 --> chọn Sub GetCPUID, chọn Options và gán một tổ hợp phím tắt nào đó --> OK. Sau này, nếu muốn chạy code, bạn nhấn tổ hợp phím đã gán.
- Ngoài ra, bạn có thể vẽ một đối tượng gì đó --> click chuột phải trên đối tượng và chọn Assign Macro --> chọn Sub GetCPUID --> OK.
Bạn tham khảo trong file nhé.

mitomcombui · 21/4/11

Cảm ơn bạn rất nhiều!

mitomcombui · 21/4/11

Thêm một câu hỏi nữa nhờ mọi người giúp đỡ: Mình có thể gộp 3 đoạn code lấy serial của Mainboard, CPU, HDD vào một nút bấm không? Đây là file có chứa đoạn code đó nhưng chỉ hiển thị có mỗi serial của mainboard thôi. file mẫu View attachment CUPHDDMAIN.xls
Các bạn giúp mình nha!

Lê Duy Thương · 21/4/11

mitomcombui đã viết:
Thêm một câu hỏi nữa nhờ mọi người giúp đỡ: Mình có thể gộp 3 đoạn code lấy serial của Mainboard, CPU, HDD vào một nút bấm không? Đây là file có chứa đoạn code đó nhưng chỉ hiển thị có mỗi serial của mainboard thôi. file mẫu View attachment 61687
Các bạn giúp mình nha!

bạn thử gộp 3 đoạn code lại như thế này xem sao

PHP:

Sub GetBoardSerial()
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
Set objs = WMI.ExecQuery("Select * from Win32_BaseBoard")
For Each obj In objs
Sheet1.[B1].Value = obj.SerialNumber
Next
 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
 For Each objItem In colItems
 Sheet1.[B2].Value = objItem.ProcessorId
 Next
     Dim fso As Object, Drv As Object
               Set fso = CreateObject("Scripting.FileSystemObject")
               Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else
                      DriveSerial = -1
                  End If
              End With
             
              Set Drv = Nothing
              Set fso = Nothing
              Sheet1.[B3].Value = DriveSerial
     End Sub

mitomcombui · 21/4/11

Lê Duy Thương đã viết:

bạn thử gộp 3 đoạn code lại như thế này xem sao

PHP:

Sub GetBoardSerial()
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
Set objs = WMI.ExecQuery("Select * from Win32_BaseBoard")
For Each obj In objs
Sheet1.[B1].Value = obj.SerialNumber
Next
 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
 For Each objItem In colItems
 Sheet1.[B2].Value = objItem.ProcessorId
 Next
     Dim fso As Object, Drv As Object
               Set fso = CreateObject("Scripting.FileSystemObject")
               Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else
                      DriveSerial = -1
                  End If
              End With
             
              Set Drv = Nothing
              Set fso = Nothing
              Sheet1.[B3].Value = DriveSerial
     End Sub

Mình đã thử rồi, không được bạn ạ.

Lê Duy Thương · 21/4/11

Bạn xem file đính kèm nhé

mitomcombui · 22/4/11

Cảm ơn bạn nhé vậy là bài toán của mình đã được giải xong rồi.Cảm ơn mọi người rất nhiều!

ndu96081631 · 22/4/11

Lê Duy Thương đã viết:

bạn thử gộp 3 đoạn code lại như thế này xem sao

PHP:

Sub GetBoardSerial()
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
Set objs = WMI.ExecQuery("Select * from Win32_BaseBoard")
For Each obj In objs
Sheet1.[B1].Value = obj.SerialNumber
Next
 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
 For Each objItem In colItems
 Sheet1.[B2].Value = objItem.ProcessorId
 Next
     Dim fso As Object, Drv As Object
               Set fso = CreateObject("Scripting.FileSystemObject")
               Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else
                      DriveSerial = -1
                  End If
              End With
             
              Set Drv = Nothing
              Set fso = Nothing
              Sheet1.[B3].Value = DriveSerial
     End Sub

Lấy thông số của CPU, Mainboard và HDD là 3 chuyện khác nhau. Theo tôi không nên gộp chung lại thành 1 code ---> Nhìn nó kỳ kỳ sao ấy
Tốt nhất cứ để nguyên code cũ, tạo 1 sub mới và gọi 3 đoạn code trên

PHP:

Sub Main()
  GetBoardSerial
  GetCPUID
  readserienumber
End Sub

Nghĩ cũng lạ! Đại ca này viết code Pro quá chừng (xài toàn... hàng hiệu)... Vậy mà lại hỏi những thứ quá.. cơ bản (chẳng hiểu làm sao cả)

mitomcombui · 22/4/11

hihi thời buổi này công nghệ phát triển như vũ bão nên mình nói với bạn là mình ko biết tí tẹo nào về VBA chắc bạn sẽ tin thôi. Tiện đây các bạn cho hỏi sao trên excel 2010 không chạy được file có macro mặc dù đã enable trong option rồi. Làm sao để mở menu Macro trong excel 2010 như trong 2003 và 2007?Bạn nào biết giúp mình với nhé. Thank!

mitomcombui · 23/4/11

nghiaphuc đã viết:
- Trước hết, bạn nên di chuyển Sub GetCPUID vào Module1, không nên để ở Sheet1 hoặc ThisWorkbook.
- Kế tiếp, bạn nhấn Alt+F8 --> chọn Sub GetCPUID, chọn Options và gán một tổ hợp phím tắt nào đó --> OK. Sau này, nếu muốn chạy code, bạn nhấn tổ hợp phím đã gán.
- Ngoài ra, bạn có thể vẽ một đối tượng gì đó --> click chuột phải trên đối tượng và chọn Assign Macro --> chọn Sub GetCPUID --> OK.
Bạn tham khảo trong file nhé.

Bạn cho mình hỏi có hàm nào giúp ta cập nhật lại thông số lấy từ hàm vừa rồi mỗi khi ta mở file đó ra không( Tức là nó sẽ tự động chạy hàm GetCPUID mỗi khi mình chạy file Excel). Thanks!!!

ndu96081631 · 23/4/11

mitomcombui đã viết:
Bạn cho mình hỏi có hàm nào giúp ta cập nhật lại thông số lấy từ hàm vừa rồi mỗi khi ta mở file đó ra không( Tức là nó sẽ tự động chạy hàm GetCPUID mỗi khi mình chạy file Excel). Thanks!!!

Thì bạn sửa Sub Thành Function đi... Gõ hàm vào cell, khỏi bấm nút

mitomcombui · 23/4/11

Bạn có thể nói rõ hơn ko? Mình mù tịt vba mà! Giúp mình với nhé. Thanks

viehoai · 23/4/11

mitomcombui đã viết:
Bạn có thể nói rõ hơn ko? Mình mù tịt vba mà! Giúp mình với nhé. Thanks

Chuyển sang Hàm như vầy phải không?

ndu96081631 · 23/4/11

mitomcombui đã viết:
Bạn có thể nói rõ hơn ko? Mình mù tịt vba mà! Giúp mình với nhé. Thanks

Trong code của bạn, chổ nào có chữ Sub thì sửa thành chữ Function... ghi thêm kết quả của Function
Ví dụ
- Code cũ của bạn:

Mã:

[COLOR=red][B]Sub[/B][/COLOR] readserienumber()
  Dim fso As Object, Drv As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Drv = fso.GetDrive(Environ("SystemDrive"))
  With Drv
    If .IsReady Then
      DriveSerial = Abs(.SerialNumber)
    Else
      DriveSerial = -1
    End If
  End With
  Set Drv = Nothing
  Set fso = Nothing
  [COLOR=red][B]Sheet1.[B3].Value[/B][/COLOR] = DriveSerial
End Sub

- Ta sẽ sửa thành:

Mã:

[COLOR=red][B]Funcion[/B][/COLOR] readserienumber()
  Dim fso As Object, Drv As Object
  [COLOR=red][B]Application.Volatile[/B][/COLOR]
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Drv = fso.GetDrive(Environ("SystemDrive"))
  With Drv
    If .IsReady Then
      DriveSerial = Abs(.SerialNumber)
    Else
      DriveSerial = -1
    End If
  End With
  Set Drv = Nothing
  Set fso = Nothing
  [COLOR=red][B]readserienumber[/B][/COLOR] = DriveSerial
End Sub

Xong, tại cell B3, bạn chỉ cần gõ công thức =Readserienumber() là xong
Các code khác sửa tương tự
Tôi làm sẳn cho bạn trong file đính kèm đây... Nhân tiện rút gọn lại code.. nó lằng nhằng quá

PHP:

Function GetBoardSerial()
  Dim obj
  Application.Volatile
  With GetObject("winmgmts:\\.\root\cimv2")
    For Each obj In .ExecQuery("Select * from Win32_BaseBoard")
      GetBoardSerial = obj.SerialNumber
    Next
  End With
End Function

PHP:

Function GetCPUID()
  Dim objItem
  Application.Volatile
  With GetObject("winmgmts:\\.\root\cimv2")
    For Each objItem In .ExecQuery("Select * from Win32_Processor")
      GetCPUID = objItem.ProcessorId
    Next
  End With
End Function

PHP:

Function Readserienumber()
  Application.Volatile
  With CreateObject("Scripting.FileSystemObject")
    With .GetDrive(Environ("SystemDrive"))
      If .IsReady Then
        Readserienumber = Abs(.SerialNumber)
      Else
        Readserienumber = -1
      End If
    End With
  End With
End Function

------------------
Nói thêm: Bạn đừng giận chứ tôi thấy bạn học viết code theo kiểu "1 bước lên mây" thế này thì biết đến khi nào mới leo được tới... nóc nhà (chứ đừng nói là mây) ---> Học phải có căn bản từ thấp lên cao chứ

mitomcombui · 23/4/11

Hihi chắc mình phải học vba thôi. cảm ơn bạn nhé!

thanhlanh · 23/4/11

mitomcombui đã viết:
Bạn cho mình hỏi có hàm nào giúp ta cập nhật lại thông số lấy từ hàm vừa rồi mỗi khi ta mở file đó ra không( Tức là nó sẽ tự động chạy hàm GetCPUID mỗi khi mình chạy file Excel). Thanks!!!

Bạn tao Sub Aut

pen trong module

PHP:

Sub Auto_Open ()
  GetBoardSerial
  GetCPUID
  readserienumber
End Sub

-------------------------------
To ndu: Sao hàm Function GetBoardSerial không cho ra kết quả gì nhỉ. Có phải tại MainBoard của mình dỏm không?

ndu96081631 · 23/4/11

thanhlanh đã viết:
To ndu: Sao hàm Function GetBoardSerial không cho ra kết quả gì nhỉ. Có phải tại MainBoard của mình dỏm không?

Không cho ra kết quả? Vậy nó ra cái gì? Báo lỗi chăng? Anh thử bấm F9 thử xem có tác dụng gì không?
Hoặc down file này về chạy thử xem thế nào nhé
Hoặc trong code trên, chổ nào có chữ GetObject anh sửa thành CreateObject xem

Lấy thông số cpu của máy tính ra một cell trong sheet (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên mới

Cạo lấy gì gội (Dịch quá không gội được)

Thành viên mới

Cạo lấy gì gội (Dịch quá không gội được)

File đính kèm

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên mới

Thành viên tích cực

Huyền thoại GPE

File đính kèm

Đếm ngược thời gian