يوليار -=بىل-=ASP ساقلىۋېلىش باش بەت قىلىش

Font Qachilash كەڭ ھالەت

قولاي تىزىملىك

ئىنتىل تورى › سەينا › Office بىلىمى › Office VBA › Office VBA دىن مىساللار (داۋاملىش ...

كېيىنكى 3 21

تىزىملىككە قايتىش

تېما يوللاش

كۆرۈش: 1912|ئىنكاس: 40

[بىلىم] Office VBA دىن مىساللار (داۋاملىشىدۇ) [ئۇلانما كۆچۈرۈش]

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-16 15:24:22 |ھەممە قەۋەتنى كۆرۈش

سەينادىكى Office ھەۋەسكارلىرىغا ئىلھام - مەدەت بولسۇن ئۈچۈن ئۆزىمىز سىناپ باققان Office VBA كودلىرىنى توپلاپ قويايلى.
سىنىيالمىغان، مەسىلە بار كودلار بولسا ئايرىم تېما قىلىپ يوللايلى.

تۆۋەندىكىسى Excel VBA دىن مىساللار

1- دەپتەرگە جەدۋەل قوشۇش ( بىرلا جەدۋەل قوشىدۇ)

Sub Addsh()
Dim Sh As Worksheet
With Worksheets
Set Sh = .Add(after:=Worksheets(.Count))
Sh.Name = "数据"
End With
End Sub

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

2- دەپتەرگە جەدۋەل قوشۇش ( ئون جەدۋەل قوشىدۇ)

Sub Addsh_2()
Dim i As Integer
Dim sh As Worksheet
For i = 1 To 10
Set sh = Sheets.Add(after:=Sheets(Sheets.Count))
sh.Name = i
Next
End Sub

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

3- Sheet1 نى ئاچقاندا باشقا جەدۋەلنى يوشۇرۇش

Private Sub Worksheet_Activate()
Dim shN As Worksheet
For Each shN In Sheets
If shN.Name <> "Sheet1" Then
shN.Visible = False
End If
Next shN
End Sub

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

4- نام سىتونىدىكى دەپتەر نامىنى

Sub AppCaption()
Application.Caption = "修改标题栏名称"
MsgBox "下面将恢复默认的标题栏名称!"
Application.Caption = Empty
End Sub

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

ياكى

Sub DleCaption()
Application.Caption = vbNullChar
MsgBox "下面将恢复默认的标题栏名称!"
Application.Caption = ""
End Sub

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

سىندەرس: سەينادىن پايدىلىنىش

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-16 15:25:10 |ھەممە قەۋەتنى كۆرۈش

《微软office vba--- Excel,Word,Access,vba

تىزىملىكى
[微软office.vba].excel_vba.rar
Excel.2002公式与函数应用宝典.pdf
Word2000VBA一册通.pdf
Excel.2003函数应用完全手册.pdf
[微软office.vba].Excel.2002.VBA.With.XML.ASP-LiB.rar
Excel.2000VBA一册通.rar
excel函数.VBA范例.rar
access初级教程iso格式.rar
daemon_虚拟光驱中文版支持iso格式.exe
[微软office.vba].Access2000_vba.pdf
微软access.sql.vba基础知识.rar
SQL语言学习循序渐进.chm
微软Word_vba范例源代码.pdf
《Excel在财会管理中的应用》电子教案.rar
SQL.Server.2000PDF格式教程.rar
sql.server教程ISO格式.rar
AccessXP语音教程.rar
Office_vba编程手册合集(CHM).rar
菜鸟级SQL21天自学通.pdf
英文版Microsoft.Office.2003操作.pdf
چۈشۈرۈش ئۇلىنىشى

ed2k://|file|英文版Microsoft.Office.2003操作.pdf|16868661|BF964D189CCE7A7622CC600BCE8569D4|h=AJP6PRQXZODPRBQ3UZWRDCAW3HQAS5EM|/
ed2k://|file|菜鸟级SQL21天自学通.pdf|2626313|11072D95FD4F4351D2C96D4E75A89349|h=5G47TUS756CDLEI5XDHAR5NR4LBYP7X6|/
ed2k://|file|Office_vba编程手册合集(CHM).rar|8448654|13B45D6A452DF7A044105212964E6B7A|h=Z35R4DCGJBQLZMF4Q6YVNIUVDPLEKSPD|/
ed2k://|file|AccessXP语音教程.rar|458781024|EB242289EFDDA100A40B3C6B2BDE97EC|h=AKIFXKZ26RMRERBB2JCJRB4AUMH4CGIT|/
ed2k://|file|sql.server教程ISO格式.rar|375690997|FA65D712F13512528B15728538B1F9BB|h=ALBSPXVWC4A5ZUOA4434OCPKT4VCANLH|/
ed2k://|file|SQL.Server.2000PDF格式教程.rar|17783394|C90068E10C92C8A25F624CDD4C9C4DFB|h=ZY4GIMRDPRLGW65YG4QS5LQBA3K26RWA|/
ed2k://|file|《Excel在财会管理中的应用》电子教案.rar|272488|308E56637F48511EE57D99B60B950F6E|h=DD4W7UJYMY4TVS37LZGNDWNVOVKA5LCF|/
ed2k://|file|微软Word_vba范例源代码.pdf|896168|F63FC179A3147B994757A0584ACFC8CF|h=GDOIQKXTFYIF3RACSI7D4CITZ3AOGU6T|/
ed2k://|file|SQL语言学习循序渐进.chm|49277|277F97A18D7346CCD1B8E3546EC66961|h=XZGDTRW474OGWSQ2QU623TUCIKIELFG2|/
ed2k://|file|微软access.sql.vba基础知识.rar|106273|237FAC499576EC40D6D2BA0614C9F798|h=J4TNOXX646P7AMQJMVMQJIIHF7RHZBEU|/
ed2k://|file|[微软office.vba].Access2000_vba.pdf|6121581|824D6F716E9268F46D66CF455915C8C9|h=DNW43NCTJNNE57NO26FXDZS3V63AR62X|/
ed2k://|file|daemon_虚拟光驱中文版支持iso格式.exe|817372|23E3C2D1902EC031159DB4EEA872C883|h=RXEDSGNIMLUXRUGVUZODGKU3NXKPDT2X|/
ed2k://|file|access初级教程iso格式.rar|285707391|07CD519A7411FDE6D63BF49D0427DFD8|h=ZF72BXP6RM4AWBAWNKB7YJ5TWFD5ZCRK|/
ed2k://|file|excel函数.VBA范例.rar|3358107|DCCE76C58DECABE5582B3D5C2BAC0730|h=LVOB5TAZTCJNHTPLIEXGLN3P2NMNLU6G|/
ed2k://|file|Excel.2000VBA一册通.rar|6789961|FA21B7E3BFB0B6F385135D39226F4CA8|h=DWIBVT7LLVDRKAN3Z667NJKJJFPAHVQH|/
ed2k://|file|[微软office.vba].Excel.2002.VBA.With.XML.ASP-LiB.rar|9017507|A1BC8888E31F97AD2838B91FF95145A2|h=ISKJS2MNMBBKHWSB47SADTKDY7QCPPVB|/
ed2k://|file|Excel.2003函数应用完全手册.pdf|187076|132611F9EC31C9151E9A468A0155523F|h=2TDUKJF2XYQGJO3IHFFMUNXCEUKPMUUD|/
ed2k://|file|Word2000VBA一册通.pdf|4406573|AFDF45D90A763F8655AEC4F9619A295F|h=BYLGACSULGLT623KZ77FT2UQYD7LSBPU|/
ed2k://|file|Excel.2002公式与函数应用宝典.pdf|18994567|5F27038E0E563A03B79DF6611A471377|h=QBOADGQ4V5TSRXCHAA6KHPERCL7JWGZQ|/
ed2k://|file|[微软office.vba].excel_vba.rar|282366662|11A432503716F5241D154A68BD1A0780|h=QXGJ6F42FX3U2BUR2QFNZIDKPE4OB7MD|/

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-16 15:25:27 |ھەممە قەۋەتنى كۆرۈش

excel VBA
بۇ ئېچىش قېتىم سانىنى كونترول قىلىش كودى

Private Sub Workbook_Open()
With ThisWorkbook.VBProject.VBComponents("ThisWorkBook").CodeModule
l = CInt(Mid$(.Lines(.CountOfLines, 1), 2, 3))
If l < 1 Then
MsgBox "试用期已过,请联系QQ:79xxx30"
.DeleteLines 1, .CountOfLines
ThisWorkbook.Sheets(1).Rows.Clear
ThisWorkbook.Save
ThisWorkbook.Close
Else
l = l - 1
MsgBox "你还有" & l & "次打开的机会!"
.InsertLines .CountOfLines, "'" & l
.DeleteLines .CountOfLines, 1
ThisWorkbook.Save
End If
End With
End Sub
'3

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

يەنە بىر خىلى

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For i = 2 To ThisWorkbook.Sheets.Count
Sheets(i).Visible = 2
Next i
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Private Sub Workbook_Open()
Dim i As Byte
Dim xFile As String
xFile = "D:\Test\abc\1.txt"
For i = 2 To ThisWorkbook.Sheets.Count
Sheets(i).Visible = -1
Next i
ChDrive Left(xFile, 2)
If Dir(xFile) = "" Then
For i = 2 To ThisWorkbook.Sheets.Count
Sheets(i).Delete
Next i
ThisWorkbook.Save
End If
End Sub

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

excel ھۆججىتىنىڭ ئۆزىنى ئۆچۈرۈش كودى
بۇ دەپتەرگە يېزىلىدىغىنى ئىكەن

Sub KillMe()
Me.ChangeFileAccess xlReadOnly
Kill Me.FullName
Me.Close False
End Sub

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

بۇ جەدۋەلگە

Sub KillMe()
Me.Parent.ChangeFileAccess xlReadOnly
Kill Me.Parent.FullName
Me.Parent.Close False
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

دەلىللەنگەن

Rank: 5 Rank: 5

تۆھپە: 1102
تىللا: 1430
شۆھرەت: 1960

يوللىغان ۋاقتى 2011-6-16 15:58:46 |ھەممە قەۋەتنى كۆرۈش

Intil يوللانغان ۋاقتى 2011-6-16 15:25
《微软office vba--- Excel,Word,Access,vba

تىزىملىكى

بۇ يەردىكى ماتىرياللارنى قانداق چۇشۇرىمىز؟

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

دەلىللەنگەن

Rank: 5 Rank: 5

تۆھپە: 1102
تىللا: 1430
شۆھرەت: 1960

يوللىغان ۋاقتى 2011-6-16 16:04:52 |ھەممە قەۋەتنى كۆرۈش

مەنمۇ بىر نى قىتىپ قوياي. بۇ كود ئەسلى نۇرغۇن دوسلارغا لازىملىق كود ئىدى لىكىن تىمنىڭ ئالدىدا [ياردەم ] دىگەن خەتنى كۆرگەن نۇرغۇن دوسلار قىززىقماي كۆرمىگەنلىكى تەبىئى .
ئەسلى مەنبە: فورمات كۆچۇرۇش توغرىسىدا
https://uyghur-archive.com/intil/home/forum- ... 5-fromuid-1428.html
ئەگەر سىزگە بىر جەدىۋەل بىرىلدى لىكىن سىز تولدۇرۇپ بولغاندا جەدىۋەل فورماتى بۇزۇلۇپ كەتكەن بولسا بۇ كودنى ئىشلىتىڭ.

Sub tuzux()
kur = Sheets("Q801").[a65536].End(xlUp).Row 'eng ahirki kur
For i = 23 To kur Step 22 'ozguruxqan kimmet i ning deslepki kimmiti 23, eng ahirki kimmiti eng ahirki kur bolsun, her ketim ozgergende 22 din atlap mangsun(bu arkilik jedwelning baxlangan ornini tepix)
Rows("1:22").Copy '1 din 22 giqe kurning nuskisini al(复制)
Rows(i & ":" & i + 21).PasteSpecial Paste:=xlPasteFormats 'kiyinki jedwellgrning baxlinix kuridin baxlinix kuriga 21 kurni koxkandin kiyinki kurgiqe tallap nuskisi elingan(复制) kurning formatini(格式) qapla
Next 'kur tugigende aylinixtin tohtat
End Sub

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

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-16 22:10:01 |ھەممە قەۋەتنى كۆرۈش

ئىنكاس قايتۇرۇش uqkun77 نىڭ يازمىسى

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-19 23:01:13 |ھەممە قەۋەتنى كۆرۈش

excel
دەپتەردىكى جەدۋەللەر ئۇچۇرىنى كۆرسىتىش

Sub ShCount1()
Dim c As Integer
Dim i As Integer
Dim s As String
c = Worksheets.Count
For i = 1 To c
s = s & Worksheets(i).Name & Chr(13)
Next
MsgBox "工作簿中含有以下工作表:" & Chr(13) & s
End Sub

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

ياكى

Sub ShCount1()
Dim c As Integer
Dim i As Integer
Dim s As String
c = Worksheets.Count
For i = 1 To c
s = s & Worksheets(i).Name & Chr(13)
Next
MsgBox "工作簿中含有以下工作表:" & Chr(13) & s
End Sub

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

دەپتەردە بەت ئۆرۈش

Sub Addsh()
Dim Sh As Worksheet
With Worksheets
Set Sh = .Add(after:=Worksheets(.Count))
Sh.Name = "数据"
End With
End Sub

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

بوش قۇرنى ئۆچۈرۈش

Sub DelBlankRow()
Dim rRow As Long
Dim LRow As Long
Dim i As Long
rRow = Sheet1.UsedRange.Row
LRow = rRow + Sheet1.UsedRange.Rows.Count - 1
For i = LRow To rRow Step -1
If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
Next
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-19 23:34:00 |ھەممە قەۋەتنى كۆرۈش

جەدۋەل قوشۇش ( كودتىكى ئارتۇق ئۇچۇرنى ئۆزىڭىز تازىلاڭ)

#001 Sub Addsh()
#002 Dim Sh As Worksheet
#003 With Worksheets
#004 Set Sh = .Add(after:=Worksheets(.Count))
#005 Sh.Name = "数据"
#006 End With
#007 End Sub

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

ياكى

#001 Sub Addsh_2()
#002 Dim i As Integer
#003 Dim sh As Worksheet
#004 For i = 1 To 10
#005 Set sh = Sheets.Add(after:=Sheets(Sheets.Count))
#006 sh.Name = i
#007 Next
#008 End Sub

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

جەدۋەل ئۆچۈرۈش

#001 Sub Delsh()
#002 Dim sh As Worksheet
#003 For Each sh In ThisWorkbook.Sheets
#004 If sh.Name <> "工作表的添加与删除" Then
#005 Application.DisplayAlerts = False
#006 sh.Delete
#007 Application.DisplayAlerts = True
#008 End If
#009 Next
#010 End Sub

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

ياكى

#001 Sub Addsh_3()
#002 Dim Sh As Worksheet
#003 For Each Sh In Worksheets
#004 If Sh.Name = "数据" Then
#005 MsgBox "工作簿中已有""数据""工作表,不能重复添加!"
#006 Exit Sub
#007 End If
#008 Next
#009 With Worksheets
#010 Set Sh = .Add(after:=Worksheets(.Count))
#011 Sh.Name = "数据"
#012 End With
#013 End Sub

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

#001 Sub Addsh_4()
#002 Dim sh As Worksheet
#003 On Error GoTo line
#004 With Worksheets
#005 Set sh = .Add(after:=Worksheets(.Count))
#006 sh.Name = "数据"
#007 End With
#008 Exit Sub
#009 line:
#010 MsgBox "工作簿中已有""数据""工作表,不能重复添加!"
#011 Application.DisplayAlerts = False
#012 Worksheets(Worksheets.Count).Delete
#013 Application.DisplayAlerts = True
#014 End Sub

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

ياكى

#001 Sub Addsh_5()
#002 Dim i As Integer, arr
#003 Dim sh As Worksheet
#004 On Error Resume Next
#005 arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
#006 For i = 0 To UBound(arr)
#007 With Worksheets
#008 Set sh = .Add(after:=Sheets(.Count))
#009 sh.Name = arr(i)
#010 End With
#011 Next
#012 Application.DisplayAlerts = False
#013 For Each sh In Worksheets
#014 If sh.Name Like "Sheet*" Then sh.Delete
#015 Next
#016 Application.DisplayAlerts = True
#017 End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-6-19 23:36:19 |ھەممە قەۋەتنى كۆرۈش

جەدۋەلنى ئۆچۈرۈشنى چەكلەش

#001 Public Ctl As CommandBarControl
#002 Sub DelSht()
#003 Set Ctl = Application.CommandBars.FindControl(ID:=847)
#004 Ctl.OnAction = "MyDelSht"
#005 End Sub
#006 Sub ResSht()
#007 Set Ctl = Application.CommandBars.FindControl(ID:=847)
#008 Ctl.OnAction = ""
#009 End Sub
#010 Sub MyDelSht()
#011 If VBA.UCase$(ActiveSheet.CodeName) = "SHEET2" Then
#012 MsgBox "禁止删除" & ActiveSheet.Name & "工作表!"
#013 Else
#014 ActiveSheet.Delete
#015 End If
#016 End Sub

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

ياكى

#001 Private Sub Workbook_Activate()
#002 Call DelSht
#003 End Sub
#004 Private Sub Workbook_Deactivate()
#005 Call ResSht
#006 End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-7-5 00:13:55 |ھەممە قەۋەتنى كۆرۈش

excel دا 1 دىن نومۇر قوشۇپ باسىدىغان كود
E3 نى تاللاپ 格式-单元格-自定义 نى بېسىپ تۆۋەندىكى كىرگۈزۈڭ

"No:"000000

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

Visul Basic 编辑器 گە ئۆتۈپ بىر دانە مودۇل(模块) قوشۇپ تۆۋەندىكى كودنى چاپلاڭ

Sub 打印()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Call dy
End Sub
Sub dy()
Dim a%, b$, c$, abc$
a = Sheets("Sheet1").Cells(3, 5).Value
b = Sheets("Sheet1").Cells(3, 6).Value
If a < b Then
a = a + 1
Sheets("Sheet1").Cells(3, 5).Value = a
Call 打印
End If
End Sub
Private Sub CommandButton1_Click()
Call 打印
End Sub

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

ئەمدى excel يۈزىگە قايتىپ بىر دانە كۇنۇپكا قوشۇپ ئۇنىڭغا ئوڭنى بېسىپ ماكروسىغا يۇقارقى ماكرونى كۆرسىتىپ جەزملەڭ.
E3 كە 1 نى كىرگۈزۈپ F3 كە باسىدىغان سانىنى كىرگۈزۈپ باسسىڭىز بولىدۇ.

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-8-17 00:04:46 |ھەممە قەۋەتنى كۆرۈش

excel دا كاتەكتىكى خەت پىچىمى ( فورماتى) نى تەڭشەش مودۇلى (模块) كودى

Option Explicit
Public Sub RngFont()
With Range("A1").Font
.Name = "华文彩云"
.FontStyle = "Bold"
.Size = 18
.ColorIndex = 3
.Underline = 2
End With
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-8-17 00:06:53 |ھەممە قەۋەتنى كۆرۈش

excel دا كاتەك پىچىمى ( فورماتى) نى تەڭشەش مودۇلى (模块) كودى يەنى رەڭگى

Option Explicit
Sub RngInterior()
With Range("A1").Interior
.ColorIndex = 3
.Pattern = xlPatternCrissCross
.PatternColorIndex = 6
End With
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-8-17 00:10:45 |ھەممە قەۋەتنى كۆرۈش

excel دا مەلۇم دائىرىدىكى كاتەككە رامكا قوشۇش مودۇلى (模块) كودى ( ئىككى خىل كود)

Option Explicit
Sub AddBorders()
Dim rng As Range
Set rng = Range("B4:G10")
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
rng.BorderAround xlContinuous, xlMedium, 5
Set rng = Nothing
End Sub
Sub BordersDemo()
Dim rng As Range
Set rng = Sheet2.Range("B4:G10")
With rng.Borders(xlInsideHorizontal)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = 5
End With
With rng.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
rng.BorderAround xlContinuous, xlMedium, 5
Set rng = Nothing
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-8-17 00:14:04 |ھەممە قەۋەتنى كۆرۈش

excel دا كاتەك ئىگىزلىكى ۋە كەڭلىكىنى بەلگۈلەش مودۇلى (模块) كودى

Option Explicit
Sub RngToPoints()
With Range("A1")
.RowHeight = Application.CentimetersToPoints(2)
.ColumnWidth = Application.CentimetersToPoints(1.5)
End With
With Range("B2")
.RowHeight = Application.InchesToPoints(1.2)
.ColumnWidth = Application.InchesToPoints(0.3)
End With
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

实名认证

ئاتامان

بېكەت باشلىقى

Rank: 32

تۆھپە: 17234
تىللا: 21527
شۆھرەت: 30008

يوللىغان ۋاقتى 2011-8-17 00:18:09 |ھەممە قەۋەتنى كۆرۈش

excel دا بىرلەش تۈرۈلگەن كاتەك بار- يوقلۇقىغا ھۆكۈم قىلىش مودۇلى (模块) كودى (ئىككى خىل)

Option Explicit
Sub IsMergeCell()
If Range("A1").MergeCells = True Then
MsgBox "包含合并单元格"
Else
MsgBox "没有包含合并单元格"
End If
End Sub
Sub IsMerge()
If IsNull(Range("E8:I17").MergeCells) Then
MsgBox "包含合并单元格"
Else
MsgBox "没有包含合并单元格"
End If
End Sub

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

ئەتە ئۆلۈپ كېتىدىغاندەك ياخشى ئەمەللەردە بول.

جابدۇق ئىشلىتىش پاش قىلىش

كېيىنكى 3 21

تىزىملىككە قايتىش

تېما يوللاش

يانفۇن|Archiver|intil.cn ( 新ICP备11001938号 )

GMT+8, 2012-11-8 14:26 , Processed in 0.329951 second(s), 18 queries .

Powered by Discuz! X2(NurQut Team) Licensed

© 2001-2011 Comsenz Inc.

چوققىغا قايتىش