AccessTr.neT
Fonksiyonda "Sıfır" Hatası - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Fonksiyonda "Sıfır" Hatası (/konu-fonksiyonda-sifir-hatasi.html)

Sayfalar: 1 2

Cvp: Fonksiyonda "Sıfır" Hatası - megasoftware - 23/03/2016

(22/03/2016, 22:34)atoz112 yazdı: sayın megasoftware,






Kod:
Function HDSerialNumber() As String
   Dim fsObj   As Object
   Dim drv     As Object
   Set fsObj = CreateObject("Scripting.FileSystemObject")
   Set drv = fsObj.Drives("C")
    HDSerialNumber = Left(Hex(drv.SerialNumber), 4) & "-" & Right(Hex(drv.SerialNumber), 4)
End Function
fonksiyon yine bu hali ile kalmalı.sadece,formun YÜKLENDİĞİNDE olay yordamındaki kodları





Kod:
Me.Vol.Caption = HDSerialNumber
Me.Vol.Caption = Left(HDSerialNumber, InStr(1, HDSerialNumber, "-") - 1)
bu şekilde yazmalısınız.böylece,tire işaretinden önceki ilk 4 değeri ekranda gösterebilirsiniz.

bilginize...iyi çalışmalar,saygılar.

Sayın hocam sorun giderilmedi "ekrana görüntüsü"nden de anlaşılacak sanırım sıkıntım..
[Resim: 14587255331.jpg]

Cvp: Fonksiyonda "Sıfır" Hatası - atoz112 - 23/03/2016

sayın megasoftware,

fonksiyon için

Kod:
Function HDSerialNumber() As String


    Dim fsObj   As Object
    Dim drv     As Object
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives("C")

If Left(Hex(drv.SerialNumber), 1) = 0 Then
    HDSerialNumber = "0" & Right(CStr(Left(Hex(drv.SerialNumber), 4)), InStr(1, CStr(Left(Hex(drv.SerialNumber), 4)), "-") - 2) & "-" & Right(CStr(Left(Hex(drv.SerialNumber), 4)), 4)
Else
    HDSerialNumber = Left(Hex(drv.SerialNumber), 4) & "-" & Right(Hex(drv.SerialNumber), 4)
End If

End Function
formun YÜKLENDİĞİNDE olay yordamı için de

Kod:
Me.Vol.Caption = HDSerialNumber
kod satırlarını yazmayı denemek ister misiniz.bilginize...iyi çalışmalar,saygılar.

Cvp: Fonksiyonda "Sıfır" Hatası - megasoftware - 23/03/2016

Hocam süpersiniz teşekkür ederim. Sorun çözülmüştür konuyu taşıyabilirsiniz. : +rep 
Son yazdığınız kod bana ilham oldu ve VOL değeri 8 krakterden oluşmak zorunda olduğundan Hex komutu "0" ve Null değerlerini desteklemeyip okumadığından öncelikle bulduğu değerin Len komutu ile basamak sayısına bakıp eğer 8 den küçükse komutu ile başa "0" eklemeyi başardım. İleride örnek olması için kodun son hali şu şekildedir..
Kod:
Public Function HDSerialNumber() As String
Dim fsObj As Object
Dim drv As Object
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set drv = fsObj.Drives("C")
Deger = Left(Hex(drv.SerialNumber), 9)
If Len(Deger) < 8 Then
    HDSerialNumber = "0" & Left(Deger, 3) & "-" & Right(Deger, 4)
Else
    HDSerialNumber = Left(Deger, 4) & "-" & Right(Deger, 4)
End If
End Function
ayrıca,formun YÜKLENDİĞİNDE olay yordamına da


Kod:
Private Sub Form_Load()
Me.Vol.Caption = HDSerialNumber
End Sub


Cvp: Fonksiyonda "Sıfır" Hatası - atoz112 - 23/03/2016

sayın megasoftware,

kendi çalışmalarınıza kendi çabalarınız ile istek ve azim akabinde olumlu sonuçlar alacak şekilde katılımcı ve katkı sağlayıcı olma girişimleriniz sizin için olumlu ve güzel bir ilerleme ve kendini geliştirme zemini oluşturacak durumdur.

kendinize dair verimliliğinizin artması temennisi ile,kutlarım.

bilginize...iyi çalışmalar,saygılar.