最新WPS办公软件学习教程_免费企业办公软件下载_金山WPS Office官网论坛

 找回密码
 
查看: 8158|回复: 19

[VBA/VBS教程] 【VBA For ET 教材连载系列】三十二

[复制链接]

399

主题

75

听众

3062

积分

测试体验团员

Rank: 14Rank: 14Rank: 14Rank: 14

该用户从未签到

金币
3
威望
5033
帖子
2014
精华
11

特殊贡献奖 最佳教程奖 活跃会员奖

发表于 2009-8-30 14:32 |显示全部楼层
分享到: 新浪微博 腾讯微博
   Inputbox函数在工作中应用非常的广泛,本节通过一个实例演示Inputbox函数搭配其它代码实现生成指定月份的月历。月历中包括该月每一天及对应的星期。* n9 T7 _; f2 {: O
   本实例除Inputbox的知识外,还涉及如下知识点:& I' U& Y' t& B9 B# x- u9 h! z4 z
   1)数据类型转换9 z. ]7 j3 h3 z" }' z6 t. n0 ^
   2)错误设置
  ?; a) b/ G. f- y6 B; B' n: D7 |8 V% w   3)日期的转化
. I0 S# `7 @% q0 b9 n   4)区域合并( ?& H1 z' R5 t" D* g/ o" A; E! [
   5VBA录入数组公式
9 v$ E/ Z# P# g. Z8 d: i8 a- L. P& U   6)文本替换
, `4 k/ D- ~; ^+ q. H   7)为单元格设置边框6 u. N4 `* ?  }% y0 p  w, B
   8)将公式转换成值
/ u: L% t3 g3 l& J: @& f   具体操作步骤如下:
6 x4 v3 ]9 F% m( Y4 E$ O2 M. w   1.打开ET 2009,使用快捷键Alt+F11〗进入VBE界面;
+ v1 s7 G- i8 m5 o6 K) c2 r   2.单击菜单〖插入〗\〖模块〗;- q: A9 K2 J" V: P) s  U
   3.在模块中录入以下代码:
5 l; B. l5 ?/ h_______________________________________________________  v% v6 j1 W$ t" e7 G

# Z: ], ]. E0 G4 h9 G% iSub 生成月历()6 `+ |9 ]+ q( t/ S
On Error Resume Next'防错:有错误时继续下一步
+ Q& t% m) e/ X4 a: i% GDim Months As Byte* w0 K4 C3 l& l- a. {5 K  a
'提供一个让用户指定月份的对话框,对话框显示屏幕左上角,其上边距和左边距均为10/ o7 w1 Q1 r2 R% ?9 d
'inputbox反回值是String型,利用CByte转换成ByteStar:
: l7 t- t% o. L1 DMonths = CByte(InputBox("请指定月份,程序将生成该月的月历", "月份", Month(Date), 10, 10))
- T& |8 L9 `% W3 I1 I4 AIf err <> 0 Then err.Clear: GoTo Star'如果有错误则返回重新输入( i8 m* x+ ?5 Y/ l+ B# z
If Months < 1 Or Months > 12 Then MsgBox "只能在1-12之间,请重新输入。", 64, "提示": GoTo Star2 r/ J1 p9 f6 G/ h& ?  ~
Application.ScreenUpdating = False'关闭屏幕更新,加快速度5 W/ `! u# C. G% M+ |1 m( w. G
With ActiveCell'在当前单元格显示当前指定月份第一日的日期8 X7 U% w5 d2 m7 V- U) E
.Value = Format(DateSerial(Year(Date), Months, 1), "yyyymd")'对首行7列合并居中
0 C; o! g* S8 p2 ?* z, m.Resize(1, 7).Merge7 F; ~; `2 d, T! W( C% [1 s8 ?+ K
.HorizontalAlignment = etHAlignCenter' 设置标题行数据并设置为居中显示产,添加颜色7 Z7 `, B$ w+ C0 @- P
With .Offset(1, 0).Resize(1, 7)7 `, p& H, x$ K# u$ t. n
.Value = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")'标题5 O: N3 w# P/ w) ], X9 U
.HorizontalAlignment = ksoCenter'居中显示6 s& O- k' a# N/ ~# R3 l0 g+ U/ y
.Interior.ColorIndex = 15'标示背景色! ~* ]: {- V4 Q' B: h. r. w
.Font.Bold = True'加粗显示
9 Y7 ?, w# ?+ l$ K% V; N+ @End With+ l9 j  M& ~: B; M
On Error GoTo err'当出错时执行Err标签处的语句# F" X5 u7 t5 L# y: f, I+ S" U
With .Offset(2, 0).Resize(6, 7)'设置公式区域
, w9 `1 F" }% v$ I0 Z'建立数组公式
5 k4 y; ]5 }* Z.FormulaArray = "=text(IF(MONTH(" & ActiveCell.MergeArea(1).Address(0, 0) & ")<>MONTH(" & ActiveCell.MergeArea(1).Address(0, 0) & "-(WEEKDAY(" & ActiveCell.MergeArea(1).Address(0, 0) & ")-1)+{0;1;2;3;4;5}*7+{0,1,2,3,4,5,6}),""""," & ActiveCell.MergeArea(1).Address(0, 0) & "-(WEEKDAY(" & ActiveCell.MergeArea(1).Address(0, 0) & ")-1)+{0;1;2;3;4;5}*7+{0,1,2,3,4,5,6}),""d"")"
* |# b: G# N1 v/ o2 y, V; ]3 O' F2 Y.HorizontalAlignment = etHAlignCenter'居中对齐
) _2 X+ z0 n% Z  [9 x5 d' d0 f9 O, Q.VerticalAlignment = etVAlignCenter
! X* ]- ?* D3 v, @# [- s# r; k# HEnd With
: I2 _& g- c1 x  t! v7 G7 LWith .Resize(8, 7)'将公式转换成值(ET中无对数组公式的转换比Excel麻烦一点)
2 e+ ?1 G" G" N9 F' E.Copy
& o0 }+ ^5 Q% f' ^$ h4 s7 ^.PasteSpecial Paste:=xlPasteValues'将公式选择粘贴,从而转换成值" n! y$ _( h7 M5 {" I
.Value = .Value'再去除绿色粘三角提示
: c: b! F7 ]' @& |5 o.EntireColumn.AutoFit'自动调整列宽
, x# w. I/ Z2 w: U1 e: S1 C; j'加边框: t8 h, y! c. K0 D, Y; b5 ]
.Borders.Weight = etThin'中间用细线/ C+ n" _1 l" T5 i
.Borders(xlEdgeLeft).Weight = etThick'四周用粗线
: C- h: `% J* p% Q( l$ [.Borders(xlEdgeRight).Weight = etThick
: |9 K' _  K( d8 v.Borders(xlEdgeTop).Weight = etThick
: b3 x/ V  v* i; T/ J.Borders(xlEdgeBottom).Weight = etThick
+ j6 b* R, Z1 d- |& yEnd With! t) X5 {: ?3 [" @4 a
End With* M8 x3 \5 Q: C
Application.ScreenUpdating = True+ \4 J9 I  B+ z  p) D
Exit Sub6 w- R) G4 d* l+ ^. T# X& m
err:9 f! t, s7 I( Q% M' n- `- G  u  r" O
Application.ScreenUpdating = True2 ?4 A2 j5 m6 j6 e' \0 a+ `& e
MsgBox "您输入的月份包括文本" & Chr(10) & "或者当前区域无法写入", 65; W% d. b& A/ m$ b, {+ C# T
End Sub
2 s3 I* o- G! q_______________________________________________________
' G9 |) C! N0 `- f  b& C0 o' V3 ?( s/ a: B8 e
   录入代码后返回工作表,通过以下步骤测试代码的可行性:( Y* P0 N3 G  h" e. N$ `
   1)选择单元格A1,然后按下快捷键【Alt+F8】打开“”对话框;' U) I. b% h% r! V! n
   2)如果工作簿中仅有一个宏,那么ET会自动选定“生成月历”,否则手工选择宏名“生成月历”并单击“执行”按钮;
8 W3 `) w4 g6 [- B( }7 n   3)此时程序将弹出图32.1所示对话框,提示用户输入日期,其默认值当前月的月份;: s" |; d+ O; x+ [1 t
   4)输入字母“A”或者输入数字13,那么程序会弹出图32.2所示对话框。因为月份只能是112之间的数字;
# B+ G2 x9 H/ e- p8 |- P' B* S# O7 ]    
9 `4 M9 x% H2 F      32.1 提示录入月份0 S- r, O# E, j- Q
   
7 A  B1 N0 F% ~0 J% s& _       32.2 错误提示0 e$ x7 G; h' |: o
   5)如果直接单击“确定“按钮,那么当前工作表中B1开始的78行将产生图32.3所示月历:' z$ Z' K, v6 N/ g/ K6 i8 m( |
   
7 l% @* y. g$ I, H      32.3 月历
" @/ N( j9 c  J9 M0 C6 C/ }6 U% a   在产生月历前,需要确保当前单元格开始右下方78行无数据,如果该区域非空,则月历会覆盖该区域中的数据;同时还要确保该区域中不存在合并单元格,因月历无法在合并单元格中录入数组公式。
4 W- W( M% g. @( M   如果读者认为以上限制太多,也可以变通地实现,突破这两个限制。方法是在当前单元格右方插入新七个空白列。插入的代码如下:" q2 }; Y. A$ c6 }  [( ~
   ActiveCell.Resize(1, 7).EntireColumn.Insert Shift:=xlToRight
" P: |( z; f% b& G9 K8 i   其中EntireColumn代表整列,如果仅仅对7个单元格进行插入,那么也只能插入7个单元格;对7列进行插入,则会相应地插入7列。8 K5 a# I5 V! s- {0 c
, K0 f8 x7 k' Q9 U8 o3 D0 p

$ R0 K+ q& j5 Z, b
0 b$ s1 Z( ~. z9 U- a
. M0 n5 B4 A3 _
& P* S! K4 D: O- U7 B) w
[ 本帖最后由 wendy   于 2009-12-23 16:06 编辑 ]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,

2

主题

0

听众

60

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
54
帖子
27
精华
0
发表于 2009-9-1 08:04 |显示全部楼层
这个好.........
回复

使用道具 举报

1

主题

0

听众

80

积分

LV.2

Rank: 2

该用户从未签到

金币
1
威望
125
帖子
61
精华
0
发表于 2013-9-5 11:19 |显示全部楼层
开始读程序了,要一点一点的看
回复

使用道具 举报

114

主题

20

听众

2万

积分

LV.18

Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18

签到天数: 1244 天

[LV.10]以坛为家III

金币
2144
威望
69396
帖子
4240
精华
0

优秀会员奖 活跃会员奖

发表于 2014-12-14 14:49 |显示全部楼层
学习一下               
回复

使用道具 举报

0

主题

1

听众

101

积分

LV.3

Rank: 3Rank: 3

签到天数: 15 天

[LV.4]偶尔看看III

金币
18
威望
165
帖子
84
精华
0
发表于 2014-12-17 08:41 |显示全部楼层
来学习教程!支持!
回复

使用道具 举报

3

主题

4

听众

1万

积分

LV.15

Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15

签到天数: 1250 天

[LV.10]以坛为家III

金币
2413
威望
27956
帖子
3443
精华
0

优秀会员奖

发表于 2014-12-21 09:41 |显示全部楼层
4 b. [0 C# R+ l7 s+ z
好帖子,来支持了!
回复

使用道具 举报

0

主题

0

听众

3

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
0
帖子
6
精华
0
发表于 2014-12-21 14:36 |显示全部楼层
vbs谢谢谢谢,找到了
回复

使用道具 举报

114

主题

20

听众

2万

积分

LV.18

Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18

签到天数: 1244 天

[LV.10]以坛为家III

金币
2144
威望
69396
帖子
4240
精华
0

优秀会员奖 活跃会员奖

发表于 2015-4-12 09:57 |显示全部楼层
jsdbplt 发表于 2014-12-14 14:49
- |3 z6 D4 J) _) l7 s6 }学习一下
6 m- g, C: S( D" M4 s3 }4 s& g
了解一下     
回复

使用道具 举报

114

主题

20

听众

2万

积分

LV.18

Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18

签到天数: 1244 天

[LV.10]以坛为家III

金币
2144
威望
69396
帖子
4240
精华
0

优秀会员奖 活跃会员奖

发表于 2015-7-26 12:29 |显示全部楼层
jsdbplt 发表于 2015-4-12 09:57 8 q( B; e' T" T5 n( H& L5 l9 A/ R
了解一下
) I7 `% d7 X: C; R9 u
参考一下            
回复

使用道具 举报

114

主题

20

听众

2万

积分

LV.18

Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18

签到天数: 1244 天

[LV.10]以坛为家III

金币
2144
威望
69396
帖子
4240
精华
0

优秀会员奖 活跃会员奖

发表于 2015-11-22 08:38 |显示全部楼层
再看一下               
回复

使用道具 举报

*滑动验证:
您需要登录后才可以回帖 登录 | 更多账号登录:

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛 ( 粤公网安备 44049102496073号 粤ICP备13015957号-1   

GMT+8, 2018-1-22 16:31

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部