VBS操控excel画点阵

523066680

代码很不规范的，刚学不久，试发……

Set objexcel = CreateObject("Excel.Application")
objexcel.Visible = True
objexcel.Workbooks.Add
Set objRange = objexcel.Range("A1","bz30")
objRange.Font.Size = 12
objrange.columns = " "    '范围内字符全为空
objrange.columnwidth = 1  '设置单元格横向长度
objrange.rowheight = 13   '设置行高度
objRange.Interior.ColorIndex = 1  '范围内的背景颜色
set xls=objexcel
dim str(1)
str(0)="33,3 33,4 33,5 33,6 33,7 33,8 33,9 33,10 33,11 33,12 33,13 " &_
  "33,14 33,15 33,16 33,17 33,18 32,17 31,16 28,6 29,6 30,6 31,6 " &_
  "32,7 32,8 31,9 30,10 29,11 28,12 26,13 24,14 " &_
  "32,6 37,5 36,6 35,7 34,7 35,7 35,8 36,9 37,10 38,11 39,12 40,13 " &_
  "41,14 43,15" 
str(1)="37,17 37,18 37,19 37,20 37,21 37,22 37,23 37,24 37,25 " &_
   "36,26 35,27 38,17 39,17 40,17 41,17 42,17 " &_
   "42,18 42,19 42,20 42,21 42,22 42,23 42,24 42,25 42,26 42,27 41,27 " &_
   "38,20 39,20 40,20 41,20 "&_
   "38,23 39,23 40,23 41,23"
color=41
for each strnow in str 
 strx=split(strnow," ")
 for each xy in strx
   tempxy=split(xy,",")
   x=int(tempxy(0))
   y=int(tempxy(1))
   xls.Cells(y,x).Interior.ColorIndex = color
   wscript.sleep 100
 next
color=37
wscript.sleep 1000
next
wscript.quitCOPY

523066680

set xls=createobject("excel.application")
xls.visible = true
call xls.workbooks.add
 
Set objRange = xls.Range("A1","bz30")
objrange.columns = " "    '范围内字符全为空
objrange.columnwidth = 1  '设置单元格横向长度
objrange.rowheight = 16   '设置行高度
 
objRange.Interior.ColorIndex = 1  '范围内的背景颜色
 
dim yx(399)
maxyx=400-1
for i=0 to maxyx
  yx(i)=i
next
 
randomize
 
for i= maxyx to 0 step -1
  randx=int(i*rnd)
  color=(i)mod(40)+3
  xynow=yx(randx)
  y=xynow\20+1
  x=(xynow)mod(20) + 1
  xls.cells(x,y).interior.colorindex = color
  yx(randx)=yx(i)
  if color > 20 then wscript.sleep 10
nextCOPY