你見過最漂亮的 Excel 表格什麼樣?

你見過最漂亮的表格什麼樣,出自誰手?


相關的問題:

怎樣做出乾淨漂亮的excel表格? - 知乎
海納   (雖然我愛用女孩子的頭像,但我是男的)     1772017-06-21 13:16:23

當然是用excel畫女神:



這個是用vbscript在excel里畫的,原理就是讀出bmp的數據,然後逐個像素地描到excel里。每個像素對應一個excel里的一個單元格。下面的代碼可以把你的女神一行行地列印在excel里。由於vb運行得慢,你可以看到女神在excel里一行行被列印出來。

我看樓上 @叛逆者 同學畫了個小黃人,可以使用同樣的原理把小黃人畫在excel里,你只需要準備一張小黃人的bmp就可以了。

我的由於是wps,不能支持那麼多單元格。沒有畫完,你們可以在excel上試一下。

附上代碼:

Set objFso = CreateObject("Scripting.FileSystemObject")
Rem Set objStream = objFso.OpenTextFile("D:\hinusDocs\vbs\tangwei.bmp", 1, True, -2)
Set objStream = CreateObject("ADODB.Stream") 
objStream.Type = 1
objStream.Mode = 3
objStream.Open
objStream.loadFromFile "C:\hinusDocs\vbs\tangwei.bmp"

dim byte1, byte2, byte3, byte4

byte1 = ascb(midb(objStream.Read(1), 1, 1))
byte2 = ascb(midb(objStream.Read(1), 1, 1))
if byte1 <> asc("B") or byte2 <> asc("M") then
	msgbox "error with file flag"
end if


REM file length
dim tmp
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

dim length
length = byte4 * 16777216 + byte3 * 65536 + byte2 * 256 + byte1


REM tow zero
tmp = objStream.read(4)
for i = 1 to lenb(tmp)
	byte1 = ascb(midb(tmp, i, 1))
	if byte1 <> 0 then
		msgbox "error with reserved"
    end if
next

REM offset
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

dim offset
offset = byte4 * 16777216 + byte3 * 65536 + byte2 * 256 + byte1



dim biSize
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

biSize = byte4 * 16777216 + byte3 * 65536 + byte2 * 256 + byte1

dim biWidth
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

biWidth = byte4 * 16777216 + byte3 * &H10000 + byte2 * &H100 + byte1

dim biHeight
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

biHeight = byte4 * 16777216 + byte3 * &H10000 + byte2 * &H100 + byte1

rem biPlanes
tmp = objStream.read(2)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))

if byte2 <> 0 or byte1 <> 1 then
	msgbox "error with biPlanes"
end if

dim biBitCount
tmp = objStream.read(2)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
biBitCount = byte2 * &H100 + byte1

dim biCompression
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

biCompression = byte4 * &H1000000 + byte3 * &H10000 + byte2 * &H100 + byte1

if biCompression <> 0 then
	msgbox "can not handle compressed bmp file"
end if

dim biSizeImage
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))

biSizeImage = byte4 * &H1000000 + byte3 * &H10000 + byte2 * &H100 + byte1

dim biXPelsPerMeter
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))
biXPelsPerMeter = byte4 * &H1000000 + byte3 * &H10000 + byte2 * &H100 + byte1

dim biYPelsPerMeter
tmp = objStream.read(4)
byte1 = ascb(midb(tmp, 1, 1))
byte2 = ascb(midb(tmp, 2, 1))
byte3 = ascb(midb(tmp, 3, 1))
byte4 = ascb(midb(tmp, 4, 1))
biYPelsPerMeter = byte4 * &H1000000 + byte3 * &H10000 + byte2 * &H100 + byte1

' pallete is not used when biBitCount == 24
tmp = objStream.read(8)

dim img, x, y
img = objStream.read()

if biSizeImage <> lenb(img) then
	msgbox "error with image size"
end if

dim oExcel,oWb,oSheet 
Set oExcel= CreateObject("Excel.Application") 
Set oWb = oExcel.Workbooks.Open("C:\hinusDocs\vbs\test.xls")

Set oSheet = oWb.Sheets("Sheet1")
for y = 1 to biHeight
	oSheet.Rows(y).RowHeight = 3
next

for x = 1 to biWidth
	oSheet.Columns(x).ColumnWidth = 0.3
next
oExcel.Visible = True

dim index, color, remainder
remainder = (biSizeImage - biWidth * biHeight * 3) / biHeight
for y = 0 to biHeight - 1
	for x = 0 to biWidth - 1
		index = (biHeight - 1 - y) * ((biWidth) * 3 + remainder) + x * 3 + 1
		byte1 = ascb(midb(img, index, 1))
		byte2 = ascb(midb(img, index + 1, 1))
		byte3 = ascb(midb(img, index + 2, 1))
		
		color = byte1 * &H10000& + byte2 * &H100& + byte3
		oSheet.Cells.item(y+1, x+1).interior.color = color
	next
next

objStream.close

在 C 盤新建目錄hinusDocs/vbs/,然後存到這個目錄下面的,保存成drawexcel.vbs,同一個目錄下還得有女神的bmp文件,我們是照著這個bmp去畫的。

然後新建一個空白的excel表,叫"test.xls",雙擊這個drawexcel.vbs運行就可以了。

海納     52018-04-20 06:29:06
這個就是逗小姑娘玩的。真正用於工作,你幹嘛不直接插入圖片?
迷途小書童     12018-04-21 01:09:04
看起來挺好玩
丘山小道     12017-06-22 14:20:45
我會替你壓住女神的棺材板的哈哈哈哈哈
雨過天晴     12017-06-22 14:20:45
卧槽,大半夜打開嚇死我了
海納     12017-06-22 14:20:45

哈哈哈,讀取顏色的代碼寫反了。等我改一下。

海納     12017-06-21 14:55:24
代碼有更新,色彩反了。
海納     12017-06-21 14:02:11
用個小的圖片或許會好。我很久以前的代碼了,看到這個問題從箱子底扒拉出來的。沒有再好好調試,肯定會有bug
知乎用户     02017-10-19 17:38:40
是的,大神,我這還不行,基本只顯示灰色和棕色,不過我覺得還可以,發給妹子看他說我挺厲害,我說有大神教我的,謝謝你!
海納     02017-10-19 14:47:51
我應該已經改過了吧。你那裡還不行?不過你確定要這麼做?
知乎用户     02017-10-19 13:22:36
大神,能抽空調下讀取顏色的代碼嗎,還想用這個討好女神呢,實圖出來太感人啊~
炙淵     02017-10-19 11:45:58
挺好,頭試試去
漫諾     02017-08-11 15:20:32

為什麼我雙擊提示我有木馬攻擊電腦???

趙夢     02017-08-08 09:25:13
忽然間 不知道說什麼好,難道這也可以
漆雕臨     02017-06-29 03:08:08
雙擊就報錯"error with image size",然後未知的運行是錯誤 代碼:800A0EC ,怎麼解?
張某某     02017-06-27 15:06:34
第七行,錯誤文件無法被打開,代碼800AOBBA,源ADODB.Stream,怎麼弄啊
躺1998129     02017-06-26 19:20:09
那個代碼是保存在哪裡啊
C7-王     02017-06-23 17:08:18
這有什麼漂亮的?沒意義啊!
光塵鏡明     02017-06-22 16:35:33
為什麼我的手機看代碼,比後台運行七八個app還卡?
風行水上     02017-06-22 12:24:12
error
張覓     02017-06-22 10:12:34
厲害了
知乎用户     02017-06-22 09:41:18
把代碼粘貼到NOTEPAD++ 運行錯誤怎麼辦?~~
龔建峰     02017-06-22 01:53:23
複製粘帖不就好了?
海納     02017-06-22 00:18:35

這個圖是通過設置每一個單元格的背景顏色實現的。

千杯酒     02017-06-22 00:16:24
wps畫?
海納     02017-06-21 21:36:01

用excel的人,學點VB的知識總不是壞事。

candy     02017-06-21 21:25:35
這是寫代碼還是做表
海納     02017-06-21 19:02:53
看著自己的照片在excel里一行一行地顯示出來,比較有趣而已。玩嘛,那還有什麼意義。
磨牙行者     02017-06-21 18:14:19
關鍵是這種方法小姑娘都不知道這是幹啥,逗不動吧。
磨牙行者     02017-06-21 18:13:20
沒啥意義吧?
旺頭     02017-06-21 18:11:36
照片要多大格式才合適呢,我弄出來的變形了
旺頭     02017-06-21 17:50:44
顯示編譯器錯誤怎麼回事
迷途小書童     02017-06-21 14:41:20

我把你的程序複製到TXT里,保存成那個格式,然後提示打不開。粘貼成TXT沒有格式了,是不是粘貼到notepad++里好一些

海納     02017-06-21 14:29:31
改一下文件名就行。我的代碼里有文件名。改成你自己的目錄和文件名。這個代碼只能玩bmp,24位真彩色的,其他格式不支持。
迷途小書童     02017-06-21 14:14:39
任何圖片都行嗎?還是只能是這一張?
五四     02017-06-21 14:08:50
我之前寫了個,輸入員工工號后自動去伺服器獲取照片然後描點。大圖片需要預處理做壓縮的,不然效率太低甚至會崩。
霜降     02017-06-21 14:00:37

挺好玩,151行出錯可能格子不夠用了,on error resume next