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

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

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

[复制链接]

397

主题

72

听众

3057

积分

测试体验团员

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

该用户从未签到

金币
3
威望
5028
帖子
2011
精华
11

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

发表于 2009-8-30 14:32 |显示全部楼层
分享到: 新浪微博 腾讯微博
   Inputbox函数在工作中应用非常的广泛,本节通过一个实例演示Inputbox函数搭配其它代码实现生成指定月份的月历。月历中包括该月每一天及对应的星期。
/ P! U# K0 x7 F3 ?& G   本实例除Inputbox的知识外,还涉及如下知识点:
2 c- E1 Q- f9 k! r: Y3 F2 K   1)数据类型转换( M9 ?8 u& [; F2 P
   2)错误设置
% V( H- ~9 ]1 `9 e: D( |; G   3)日期的转化
# e- g$ s* ~% D. Z. }+ Q   4)区域合并
5 j6 x) E; i' D3 L9 @   5VBA录入数组公式
+ \- C; ?! v, n, Q# {" @   6)文本替换
# Y  v- E1 d, ], T4 e0 [   7)为单元格设置边框2 f: p( f; _$ m" V) c8 f
   8)将公式转换成值9 Q4 e2 t  h  d) c5 \
   具体操作步骤如下:) G# m! A: L1 u7 F
   1.打开ET 2009,使用快捷键Alt+F11〗进入VBE界面;
$ ~: T! Z8 q& |2 N7 A   2.单击菜单〖插入〗\〖模块〗;' G- G6 Y) \# _; X, b
   3.在模块中录入以下代码:" @9 `! M1 n7 M5 h+ I( W7 b
_______________________________________________________
( O$ {/ \% l* y8 t! l; L& K3 o+ g6 g4 x& B
Sub 生成月历()
5 q. W% Q  _) ^! ]- @4 EOn Error Resume Next'防错:有错误时继续下一步8 [6 V8 O# s, [$ Z6 _
Dim Months As Byte
$ I& i1 A6 B- H4 J; K/ R+ i'提供一个让用户指定月份的对话框,对话框显示屏幕左上角,其上边距和左边距均为10
3 E( V; ]& h7 M4 |  m6 Q) T'inputbox反回值是String型,利用CByte转换成ByteStar:
' k9 Q$ a0 J% `, G# A+ oMonths = CByte(InputBox("请指定月份,程序将生成该月的月历", "月份", Month(Date), 10, 10))% ]! |5 [5 U0 l6 q' p
If err <> 0 Then err.Clear: GoTo Star'如果有错误则返回重新输入6 H% n0 H; ~- G2 y" ~/ }" `6 ~
If Months < 1 Or Months > 12 Then MsgBox "只能在1-12之间,请重新输入。", 64, "提示": GoTo Star
- c' f) L3 N1 o+ W! X7 {9 H0 UApplication.ScreenUpdating = False'关闭屏幕更新,加快速度
. g; O4 T- g2 \, d$ v/ p/ M) J- h4 o# \With ActiveCell'在当前单元格显示当前指定月份第一日的日期: K: E* g2 ]8 `# n2 [+ j% ^
.Value = Format(DateSerial(Year(Date), Months, 1), "yyyymd")'对首行7列合并居中
& l7 S* G2 N1 W$ q* F2 Z.Resize(1, 7).Merge, L) Y. s' P3 a3 N
.HorizontalAlignment = etHAlignCenter' 设置标题行数据并设置为居中显示产,添加颜色5 u/ b1 v- L5 \1 A9 p
With .Offset(1, 0).Resize(1, 7)) l2 O) h" j; t% g
.Value = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")'标题
2 S! J4 ?% g, y* ]( E) L.HorizontalAlignment = ksoCenter'居中显示& P+ m0 s; F& z* D
.Interior.ColorIndex = 15'标示背景色2 p' I% K0 a! A; i7 U8 X
.Font.Bold = True'加粗显示
9 T8 S( W  e# H/ V3 @% PEnd With
0 F8 v% X; a5 y6 |On Error GoTo err'当出错时执行Err标签处的语句
, |% n! D* [# }5 ~. FWith .Offset(2, 0).Resize(6, 7)'设置公式区域
4 @+ j6 T" t; v# e) X% F8 Z$ V2 {' ['建立数组公式
# @% G3 o5 ^1 B, H( r.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"")"6 h% H! u, R1 \) H0 Y
.HorizontalAlignment = etHAlignCenter'居中对齐
$ x0 r  d+ R! Q: V.VerticalAlignment = etVAlignCenter; ^: c1 W& E( {+ A* P- _
End With
( S& N2 B# z1 ~8 p3 DWith .Resize(8, 7)'将公式转换成值(ET中无对数组公式的转换比Excel麻烦一点)
) E0 a- D& o* s$ s5 }8 e.Copy
0 @% q& N& e6 }6 R! @.PasteSpecial Paste:=xlPasteValues'将公式选择粘贴,从而转换成值
! ~+ s  E, o, B0 ~.Value = .Value'再去除绿色粘三角提示
* S' t: U6 X: S+ J; @$ Z& d  _.EntireColumn.AutoFit'自动调整列宽' S. G% N  D( B' g/ |* L8 d6 d
'加边框
6 e' k: n; h# v& U0 n$ o$ A.Borders.Weight = etThin'中间用细线+ I: a$ K" Z( L* e. f, p( `
.Borders(xlEdgeLeft).Weight = etThick'四周用粗线
+ b% [8 E7 H/ t6 R+ Z.Borders(xlEdgeRight).Weight = etThick
7 c: X. b# j7 s8 y) Z.Borders(xlEdgeTop).Weight = etThick
$ B  R, `( E/ [$ E" ~' L" h7 S7 g.Borders(xlEdgeBottom).Weight = etThick
; U0 F2 [, L! \1 U4 y: ^6 k! l* C# ^End With+ @7 i- y. A8 z/ C
End With4 b* y: _- L% t1 L" }, m
Application.ScreenUpdating = True
% z( v5 b, A# R, YExit Sub$ X) @" Z" b$ R* v* \4 v
err:* r3 o; i# Z4 J
Application.ScreenUpdating = True8 D( o: c3 ~$ U3 l
MsgBox "您输入的月份包括文本" & Chr(10) & "或者当前区域无法写入", 65  k8 m+ v4 H+ ?: P
End Sub1 V; g. }. l" ^8 ?  `1 w- b9 w
_______________________________________________________& a& U: W1 s. Y; }/ S0 Q" W( I- W

; b/ [: ^  R. s; F7 N   录入代码后返回工作表,通过以下步骤测试代码的可行性:
' w  O% [5 P6 Z+ I+ {5 D- @   1)选择单元格A1,然后按下快捷键【Alt+F8】打开“”对话框;
3 _+ l$ X; l: l; S' E' N% X1 N   2)如果工作簿中仅有一个宏,那么ET会自动选定“生成月历”,否则手工选择宏名“生成月历”并单击“执行”按钮;
( ]9 e' w* T/ H+ `" K2 N7 d' p& l6 [   3)此时程序将弹出图32.1所示对话框,提示用户输入日期,其默认值当前月的月份;
$ B# X$ _7 e- v2 ^( k   4)输入字母“A”或者输入数字13,那么程序会弹出图32.2所示对话框。因为月份只能是112之间的数字;3 C+ v: N' q; M4 \1 x! A& w
    
" t- e. T$ f7 M      32.1 提示录入月份
' X9 ^# i8 B  y   5 y( s  H& b5 o7 I2 d; a2 j
       32.2 错误提示
, Z; ?& A9 w. q, E+ K0 G% H: v6 G   5)如果直接单击“确定“按钮,那么当前工作表中B1开始的78行将产生图32.3所示月历:6 d0 z& c/ R4 W4 {
   
: o( J! j4 R2 U0 k$ _      32.3 月历% u" |7 h" S! W4 ~3 z# k
   在产生月历前,需要确保当前单元格开始右下方78行无数据,如果该区域非空,则月历会覆盖该区域中的数据;同时还要确保该区域中不存在合并单元格,因月历无法在合并单元格中录入数组公式。8 V& A5 W: B. g9 [# X
   如果读者认为以上限制太多,也可以变通地实现,突破这两个限制。方法是在当前单元格右方插入新七个空白列。插入的代码如下:* [$ ]7 G+ Z4 z2 S+ _' S
   ActiveCell.Resize(1, 7).EntireColumn.Insert Shift:=xlToRight1 J& ?9 P: r" i6 s1 L
   其中EntireColumn代表整列,如果仅仅对7个单元格进行插入,那么也只能插入7个单元格;对7列进行插入,则会相应地插入7列。
/ F* f$ `- b; g3 K/ C2 J1 q: Z& ]3 A) t
( d' M. a' u; ]. a% ]: n5 T

! P$ \% P8 ?7 s/ r
! ?% F0 p3 u$ h1 s( K& b3 `0 k
' i7 z/ K9 G( X
[ 本帖最后由 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 |显示全部楼层
开始读程序了,要一点一点的看
回复

使用道具 举报

110

主题

18

听众

2万

积分

LV.17

Rank: 17Rank: 17Rank: 17Rank: 17Rank: 17

签到天数: 1181 天

[LV.10]以坛为家III

金币
2069
威望
66760
帖子
4062
精华
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

主题

3

听众

1万

积分

LV.15

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

签到天数: 1187 天

[LV.10]以坛为家III

金币
2350
威望
27020
帖子
3380
精华
0

优秀会员奖

发表于 2014-12-21 09:41 |显示全部楼层
: u  ]0 I8 g) W1 T7 d7 U: Y( u
好帖子,来支持了!
回复

使用道具 举报

0

主题

0

听众

3

积分

LV.1

Rank: 1

该用户从未签到

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

使用道具 举报

110

主题

18

听众

2万

积分

LV.17

Rank: 17Rank: 17Rank: 17Rank: 17Rank: 17

签到天数: 1181 天

[LV.10]以坛为家III

金币
2069
威望
66760
帖子
4062
精华
0

优秀会员奖 活跃会员奖

发表于 2015-4-12 09:57 |显示全部楼层
jsdbplt 发表于 2014-12-14 14:49
; |/ \8 R0 Z. T- X9 Y  y, W, v学习一下
& c3 k3 ?( A' J6 `$ g4 y3 i
了解一下     
回复

使用道具 举报

110

主题

18

听众

2万

积分

LV.17

Rank: 17Rank: 17Rank: 17Rank: 17Rank: 17

签到天数: 1181 天

[LV.10]以坛为家III

金币
2069
威望
66760
帖子
4062
精华
0

优秀会员奖 活跃会员奖

发表于 2015-7-26 12:29 |显示全部楼层
jsdbplt 发表于 2015-4-12 09:57 * }0 O$ O* R4 @
了解一下

* B: E2 y: M9 b4 H5 i参考一下            
回复

使用道具 举报

110

主题

18

听众

2万

积分

LV.17

Rank: 17Rank: 17Rank: 17Rank: 17Rank: 17

签到天数: 1181 天

[LV.10]以坛为家III

金币
2069
威望
66760
帖子
4062
精华
0

优秀会员奖 活跃会员奖

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

使用道具 举报

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

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛     

GMT+8, 2017-11-20 08:07

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部