Ali je možno ???

[jurin]

Ali je možno na kak način excel prepričati, da v neko celico vpiše serijsko številko nekega dela opreme iz računalnika, na primer diska. To bi se naj zgodilo ob vsakem zagonu datoteke. Tako bi lahko naredil, da datoteka nebi bila prenosljiva na druge računalnike ...???
Vsem hvala za odgovore in ideje.

[admin]

Spodaj imate funkcijo, ki vam bo vrnila (naj bi vam vrnila ) serijske številke vseh diskov v sistemu:

Koda: Izberi vse

Sub SerijskaStevilkaDiska()
    Dim obj As Object
    Dim WMI As Object
    Set WMI = GetObject("WinMgmts:")

    For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
        Debug.Print "Serijska št.: " & obj.SerialNumber
    Next
End Sub

[jurin]

POzdravljeni !

Najprej hvala za odgovor.
Meni pa zadeve vseeno ne uspe prepričat, da mi številko naprimer vpiše v celico A1

????
LP

[admin]

No malce se pa le potrudite! Saj imate vse na krožniku!

[jurin]

Tako, zdaj pa imam poln krožnik orehov, le da jih jaz jem z lupino vred pa niso najboljši....
Super mi številko izpiše v okno Immediate - zdaj je pa tam. In kar je najbolj žalostno, tudi po mejem trudu tam tudi ostane. Res ne vem kaj ji je v tem oknu tako všeč ????

[admin]

,

Ah, no... Ne vem če ste se ravno potrudili vsaj za 10 sec.:

Koda: Izberi vse

Sub SerijskaStevilkaDiska()
    Dim obj As Object
    Dim WMI As Object
    Set WMI = GetObject("WinMgmts:")

    For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
        Cells(1, 1) = "Serijska št.: " & obj.SerialNumber
    Next
End Sub

Tole pa ja ni takšna znanost??? No zapisana koda, ki je praktično identična tisti originalni bi v celico zapisala samo številko zadnjega diska, v kolikor jih je več.

To pa je koda, ki bi v A1 vpisala serijke št. vseh diskov, lepo vsakega v svoji vrstici:

Koda: Izberi vse

Sub SerijskaStevilkaDiska()
    Dim obj As Object
    Dim WMI As Object
    Set WMI = GetObject("WinMgmts:")

    Dim Serijske As String
    For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
        If (Serijske = "") Then
            Serijske = Serijske & "Serijska št.: " & obj.SerialNumber
        Else
            Serijske = Serijske & Chr(10) & "Serijska št.: " & obj.SerialNumber
        End If
    Next
    
    Cells(1, 1) = Serijske
End Sub

[jurin]

Kako enostavno, skoraj kot kolo...

Hvala 100 krat