Excel VBA ئارقىلىق بارماق دىسكىنى قارانچۇق قىلىش

mouse · ۋاقتى: 2014-2-24 21:05:36

ئارقا كۆرۈنۈش

بەزى ھەقلىق دېتاللارغا بارماق دىسكا دېگەندەك سىرتتىن چېتىلىدىغان ئۈسكىنەلەرنىڭ تەرتىپ نۇمۇرىنى ئېلىش ئارقىلىق دېتالنىڭ يېشىلىپ كېتىشىنىڭ ياكى ئوغىرى نەشىرىنىڭ كۆپىيىپ كېتىشىنىڭ ئالدى ئېلىنىدۇ.بۇ تېمىمىزدا سۆزلەنمەكچى بولغان مەزغۇن بولسا مۇھىم بولغان Excel ھۆججەتلىرىمىزنىڭ باشقىلارنىڭ يۇشۇرۇنچە تەھرىرلەش ئېلىپ بېرىشى، كۆچۈرۈشى،ئۆزگەرتىشىنى بارماق دسكىنىڭ تەرتىپ نۇمۇرىنى ئېلىپ ئارقىلىق Excel ھۆججەتلىرىمىزنى مەخپى ساقلاش مەقسىتىگە يېتىش.يەنى، تەرتىپ نۇمۇرى ماس كەلگەن بارماق دىسكىنى كومپيۇتېرغا چاتقاندىن كېيىن ماس بولغان Excel ھۆججىتى ئېچىلىدۇ. ئەگەر، تەرتىپ نۇمۇرى ماس كەلسە ھۆججەت ئېچىلىدۇ ۋە تەرتىپ نۇمۇرى ماس كەلگەنلىك ئۇچۇرى چىقىدۇ؛ئەگەر ئۇنداق بولمىسا،ھۆججەت تەرتىپ نۇمۇرى ماس كەلمىگەنلىك ئۇچۇرى چىقىرىدۇ ۋە ھۆججەت ئۆزلىكىدىن چېكىنىدۇ.

ھەل قىلىش ئۇسلى تۆۋەندىكىدەك
1. قەدەم: چېتىلغان بارماق دىسكىنىڭ تەرتىپ نۇمۇرىنى ئېلىش توۆەندىكى كود ئارقىلىق ئەمەلگە ئاشۇرىلىدۇ.
كومپيۇتېرنىڭ خالىغان جايىغا بىر دانە Excel ھۆججىتى قۇرۇپ خىزمەت جەدۋىلىىگە بىر دانە كۇنۇپكا قۇشۇپ كۇنۇپكا قوشقان خىزمەت جەدۋىلىىنىڭ كود ئورنىغا تۆۋەندىكى كودنى چاپلاڭ
Excel 控件工具箱 نى قوزغۇتۇپ بىر كۇنۇپكا ( CommandButton.1 ) نى قوشۇپ شۇنىڭ كودىنىڭ ئورنىغا چاپلىساقمۇ بولۇدۇ.

Private Sub CommandButton1_Click()
CommandButton1.Caption = ChrW(1578) & ChrW(1749) & ChrW(1585) & ChrW(1578) & ChrW(1609) & ChrW(1662) & ChrW(32) & ChrW(1606) & ChrW(1735) & ChrW(1605) & ChrW(1735) & ChrW(1585) & ChrW(1609) & ChrW(1606) & ChrW(1609) & ChrW(32) & ChrW(1574) & ChrW(1744) & ChrW(1604) & ChrW(1609) & ChrW(1588)
Dim fs, d, s
On Error Resume Next
For i = 3 To 26
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(Chr(64 + i) & ":")
s = d.SerialNumber
Cells(i, 2) = d.SerialNumber
Cells(i, 1) = Chr(64 + i) & ":"
Next i
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

2- قەدەم: تەرتىپ نومۇرىغا ئېرىشىش:
كۇنۇپكىنى باسساق C دىن Z غىچە بولغان دىسكا رايونىنىڭ تەرتىپ نۇمۇرىنى ھاسىل قىلىدۇ.
بۇنىڭدىكى بارماق دىسكىنىڭ تەرتىپ نۇمۇرىنى كۆچۈرۈۋالىمىز. مەسىلەن: بارماق دىسكانىڭ بەلگىسى H بولسا H نىڭ ئۇدۇلىدىكى تەرتىپ نومۇرىنى كۆچۈرۈۋالىمىز.
مۇناسىۋتلىك رەسىم

3- قەدەم: .تەرتىپ نۇمۇرىنى سېلىشتۇرۇش ۋە مۇناسىۋەتلىك ئۇچۇر چىقىرىش-توۋەندىكى كود ئارقىلىق ئەمەلگە ئاشىدۇ.
بايىقى Excel ھۆججىتىنىڭ كود رايۇنىدىكى thisworkbook نىڭ كود رايونىغا تۆۋەندىكى كودنى چاپلايمىز ۋە بۇ كودتىكى Case نىڭ كەينىدىكى تەرتىپ نومۇرنى بايا ھاسىل قىلىپ كۆچۈرۈۋالغان تەرتىپ نومۇرىغا ئالماشتۇرۇپ Excel ھۆججىتىنى ساقلاپ چېكىنىمىز.

Private Sub Workbook_Open()
Dim fs, d, s$
Dim SerBoolean As Boolean
SerBoolean = False ' barmaq disk mas kelgen yaki kelmigenlikini tekshurush uchun ishlitilidu
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
StrDrive = "B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
StrDriveArray = Split(StrDrive, ",")
For StartPos = 1 To UBound(StrDriveArray)
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(StrDriveArray(StartPos) & ":\\")))
If d.DriveType = 1 Then
s = d.SerialNumber
Select Case s
Case "-593846073" 'barmaq disk ka tertip numuri
SerBoolean = True
Set fs = Nothing
Set d = Nothing
s = ""
End Select
Set fs = Nothing
Set d = Nothing
End If
Next
If SerBoolean Then
MsgBox "tertip numuri mas keldi,merhemet!"
Else
MsgBox "tertip numuri mas kelmidi,hojjet hazirla taqilidu! "
ThisWorkbook.Close False
End If
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

4- قەدەم:ئىجرا ئۇنۇمى
بايىقى بارماق دىسكىنى كومپيۇتېردىن تېپىپ چىقىۋېتىپ قايتىدىن چېتىپ بايىقى Excel ھۆججىتىنى قوزغاتساق بارماق دىسسكا بايىقى بارماق دىسكا ھەم H دىسكا بولغان بولسا Excel ھۆججىتى بىزگە تەرتىپ نۇمۇرىنىڭ توغرا ئىكەنلىكى ئەسكەرتىدۇ ۋە نورمال ئېچىلىدۇ بولمىسا Excel ھۆججىتى تاقىلىدۇ.

تورداشلارنىڭ ئاكتىپ پىكىر قاتناشتۇرىشىنى ئۈمىد قىلىمەن، چۈنكى بۇنىڭ بىر قانچە يېتەرسىزلىكى بار بولۇپ، تورداشلارنىڭ قىزغىنلىقىغا ئاساسەن بۇ تېمىنى دۋاملاش تۇرىمەن.
مەنبە:چاشقان تور خاتىرىسى

Intil · ۋاقتى: 2014-2-24 22:14:55

كۆپرەك تورداشلار سىناپ تەكلىپ- پىكىر قالدۇرۇڭلار.
جەرياننى سىنلاپ قويدۇم

http://v.youku.com/v_show/id_XNjc3ODQwNDYw.html

Omar14 · ۋاقتى: 2014-2-24 23:56:15

ماۋۇ ئېسىل بىلىمكەنغۇ ..........
بۇ گەپچە چوقۇم ئىچ دىسكا بولسا ھەم تەرتىپ نومۇرى توغرا كەلسە ئاندىن ئىچىلامدا ؟؟؟ ئەگەر باشقا بارماق دېسكىنى بۇرۇن چىتىپ قالساق ئىچ دېسكا بولماي قالا ..... قىنى بىر سىناپ باقاي جۇما

miradil48 · ۋاقتى: 2014-2-25 00:37:37

نىنىڭ كومپىيۇتىرىمدا بارماق دىسكا سالسا Hدىسكا قاتارىدا چىقىدۇ ، ئىككىنچىسىنى چاتسام j دىسكا دەپ چىقىدۇ ،ئەگەر ئەگەر سىز دىگەندەك مەسىلەن H دىسكىنىڭ كود نۇمىرىنى خاتىرلىۋىلىپ ،ئىككى ياكى ئۈچ بارماق دىسكىنى ئالماشتۇرۇپ چاتساق بۇئامال يەنە ئىشلەۋىرەمدۇ؟

بايقاش · ۋاقتى: 2014-2-25 00:55:03

ياخشى ئۇسۇلكەن. word ھۆججىتىگىمۇ قىلغىلى بولامۇ؟

Omar14 · ۋاقتى: 2014-2-25 01:16:47

مەن سىناپ باقتىم ئاۋۇ VBA كودى ساقلانمىدى .... ھۆججەتنى قايتا ئاچسىلا يوقاپ كىتىدىكەن ...

Intil · ۋاقتى: 2014-2-25 01:47:00

Omar14 يوللىغان ۋاقتى 2014-2-25 01:16
مەن سىناپ باقتىم ئاۋۇ VBA كودى ساقلانمىدى .... ھۆججەتنى قا ...

مەن XP مۇھىتىدا Excel 2003 تە سىنىدىم، تېمىدىكىدەك ئۈنۈمگە ئېرىشتىم.

Omar14 · ۋاقتى: 2014-2-25 17:56:04

Intil يوللىغان ۋاقتى 2014-2-24 23:47
مەن XP مۇھىتىدا Excel 2003 تە سىنىدىم، تېمىدىكىدەك ئۈنۈمگە ...

ھۆججەتنى ساقلاپ ئۆچۈرۋىتىپ قايتا ئىچىپ باقتىڭىزما .... رەسىمدىكىدەك ئۈنۈمگە مەنمۇ ئېرىشكەن ، لىكىن قايتا ئاچسام كودلارنىڭ ھىچقايسىسى ساقلانماپتۇ

uqkun77 · ۋاقتى: 2014-2-25 19:59:19

ئەگەر ماكرونىڭ بىخەتەرلىكىنى يۇقىرى قىلىۋىتىپ ئىشلەتسە يەنىلا بۇ كود ئىشلىمەيدۇ.

mouse · ۋاقتى: 2014-2-25 20:14:11

uqkun77 يوللىغان ۋاقتى 2014-2-25 19:59
ئەگەر ماكرونىڭ بىخەتەرلىكىنى يۇقىرى قىلىۋىتىپ ئىشلەت ...

شۇنداق. مەن بۇنى dll ياكى exe ھالەتتە قوزغىلىدىغان قىلماقچى.مۇشۇنداق قىلىش مۇۋاپىقىيەتلىك بولسا سىز دېگەن مەسىلىمۇ ھەل بولىدۇ.

uqkun77 · ۋاقتى: 2014-2-25 20:28:25

مىنىڭ بارماق دىسكامنى تاپمىدى؛

mouse · ۋاقتى: 2014-2-25 21:46:45

uqkun77 يوللىغان ۋاقتى 2014-2-25 20:28
مىنىڭ بارماق دىسكامنى تاپمىدى؛

سۇئال:بارماق دىسكىڭىز ئىلگىرى فورماتلانغانمۇ؟

باشقا ئېغىزلارغا چېتىپ سىناپ باقتىڭىزمۇ؟

بارماق دسىكىنىڭ تەرتىپ نۇمۇرىنى ئېلىش ئۈچۈن ماۋۇ كودنى سىناپ بېقىڭ.

Sub DetectUdisk()
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where DriveType = 2")
For Each objDisk In colDisks
RemovableDrive = objDisk.DeviceID
If CreateObject("Scripting.FileSystemObject").GetDrive(RemovableDrive).IsReady Then
s = CreateObject("Scripting.FileSystemObject").GetDrive(RemovableDrive).SerialNumber
Exit For
End If
Next
If s <> "" Then
Range("Sheet1!d8") = s
Else
Range("Sheet1!d8") = "chitilghan barmaq diska bayqalmidi"
End If
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

Intil · ۋاقتى: 2014-2-25 22:08:26

Omar14 يوللىغان ۋاقتى 2014-2-25 17:56
ھۆججەتنى ساقلاپ ئۆچۈرۋىتىپ قايتا ئىچىپ باقتىڭىزما .... ...

مان ھازىر بارماق دىسكىنى چېتىپ Excel ھۆججىتىنى ئاچسال تونۇدى.

yarkanboy · ۋاقتى: 2014-2-25 23:42:33

بۇ يازمىنى ئاخىرىدا yarkanboy تەھرىرلىگەن. ۋاقتى 2014-2-25 23:48

مەن خاتا چۈشىنىۋالمىغان بولسام ..... سىزنىڭ بۇ يەردە دىمەكچى بولغىنىڭىز ....

بارماق دىسكىنى سالسا ئاندىن قوزغىلىدىغان دىتاللارنى مۇشۇ ئۇسۇلدا مەخپىيلەشتۈرەمدۇ..... ؟

مۇنداقچە ئىلىپ ئېيتقاندا يۇمشاق دېتال ياسىغاندا مۇشۇ ئۇسۇلنى قوللانساق بىزمۇ يۇقارقىدەك بارماق دىسكا ئارقىلىق قوزغىلىدىغان قىلىپ ياسىيالايمىز ... دەڭە.

خاتا چۈشىنىۋالمىغانلا بولسام، نەچچە ۋاقىتتىن بىرى سەۋەبىنى بىلەلمەي كىلىۋاتقان ئەڭ چوڭ مەسىلەم ھەل بولغان بولىدۇ.

ئەمما لىكىن Excel دا مانداق قىلغىلى بولىدىغانلىقى ئۇخلاپ چۈشۈمگىمۇ كىرمەپتىكەن ... شۇنىڭغا قارىغاندا Excel بىلەن بەكرەك ئېتىشسسا بىرەر يۇمشاق دېتالنىڭ رولىنى ئوينايدىكەن جۇما.

yarkanboy · ۋاقتى: 2014-2-25 23:46:16

مۇشۇ Excel VBA بىلىملىرىگە ئالاھىدە ئىشتىياقىم بار ..... لىكىن قەيەردىن باشلاپ ئۈگۈنۈشنى پەقەتلا بىلەلمىدىم.... ئىنتىل سەيناسىدىكى بەزى بىر بىلىملەرنىمۇ خىلى كۆرۈپ باقتىم بولمىسا .... يەنىلا ئۈگۈنۈش باش نوقتىسىنى تاپالمىدىم.

ئىمكانىيتىڭلار يار بەرسە ئۇيغۇرچە دەرسلىك بولسا تېخى ياخشى ... بولمىغاندىمۇ ياخشىراق سۆزلەنگەن خەنزۇچە دەرسلىك بولسىمۇ مەيلى كۆرۈش ياكى چۈشۈرۈش ئادىرىسىنى قالدۇرۇپ قويغان بولساڭلا ... مەنمۇ سىلەرنىڭ سىپىڭلارغا قوشىلىۋالسام.....

ھېسابات		ساقلاش	پارول قايتۇرىۋېلىش
پارول			تىزىملىتىش

مىكروبلوگ[ يېڭى | 24 سائەت | 7 كۈن | 30 كۈن ]

Excel VBA ئارقىلىق بارماق دىسكىنى قارانچۇق قىلىش

باھالاش

مۇناسىۋەتلىك تېمىلار

باھا سۆز

باھا سۆز

باھا سۆز

باھا سۆز

باھا سۆز

باھا سۆز

باھا سۆز