Excel+VBA处理高斯光束

文章目录

1 图片导入与裁剪
2 获取图片数据
3 数据拟合

1 图片导入与裁剪

插入图片没什么好说的，新建Excel，插入->图片。

由于图像比较大，所以要对数据进行截取，选中图片之后，点击选项卡右端的图片格式->裁剪，将光斑所在区域截取出来，如图所示

由于灰度图像在观感上比较单一，故可以通过重新着色的方法，为其添加伪彩色。

首先，复制一张图片，点击图像格式->颜色->重新着色；或者在颜色下选择其他变体，

然后将图片导出，由于Excel功能的限制，我们没法直接导出图片，所以将图片复制到PPT中，然后右键图片->另存为图片。为了便于后续的处理，保存为bmp格式。

2 获取图片数据

在选中图片的值之后，就可以提取图片中的数据了，我们需要用到VBA工具。如果初次使用，选择文件->选项->自定义功能区->选中开发工具。

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-dbkVeQlv-1631711433137)(GaussImg/vba3.png)]

添加之后，在菜单栏选择开发工具->插入->按钮，从而插入一个按钮，右键按钮->编辑文字，更名为加载数据。

然后右键按钮->指定宏，在弹出的对话框中添入Load_Click，然后点击新建，便可到达VBA编辑界面。并且已经写好了

Sub Load_Click()
End Sub

接下来我们就开始编写图片的编辑方法。

BMP文件包括三个部分，分别是文件头、颜色映射表和图片数据，其中文件头总计54位，存储着图片的格式宽高等信息；而数据区则根据图片的深度以及颜色信息对像素的值进行存储。

尽管我们拍摄的图像是灰度图，但经过PPT的重新存储，变成了24位的RGB图像，我们只需选择其中的一个通道即可。

VBA中通过单引号'进行注释。

Sub Load_Click()Const file As String = "E:\Pictures\Facula1.bmp"Dim bytes() As ByteDim width, height, stride As Long   '分别位图像的宽, 高, 偏移'获取bmp图片二进制数组Open file For Binary As #1 '#1表示文件编号ReDim bytes(LOF(1) - 1)      '重新定义bytes的长度Get #1, , bytes              '将文件1的内容写入bytesClose #1For i = 0 To 3start = start + bytes(i + 10) * 256 ^ iwidth = width + bytes(i + 18) * 256 ^ i     'bitmap中第18-21位为列数height = height + bytes(i + 22) * 256 ^ i   'bitmap中第22-25位为行数Nextstride = width * 3 + 2If (stride Mod 4) <> 0 Thenstride = stride - (stride Mod 4) + 4       'bitmap格式每行必须是4的倍数End IfCells.ClearFor i = 1 To heightFor j = 1 To widthpos = start + (j-1) * 3 + (i - 1) * strideCells(i, j).Value = bytes(pos)      '将像素的灰度值赋给单元格NextNext
End Sub

点击加载数据按钮，就可以看图像的数据被加载到单元格中。

若将赋值语句Cells(i, j).Value = bytes(pos)变成颜色变化，则可以通过单元格复现图像。

'...For i = 1 To heightFor j = 1 To widthpos = start + (j-1) * 3 + (i - 1) * stride'将单元格的颜色变为图像的颜色Cells(i, j).Interior.Color = RGB(bytes(pos + 2), bytes(pos + 1), bytes(pos))NextNext

点击加载数据，就可以看到如下情景

3 数据拟合

当我们得到图像中的数据之后，需要对每一行的最大值进行提取。将鼠标定位到第一行数据的最后一列GH，在新的一列GI中输入=MAX(A1:GH1)，从而从第一行的所有数据中求得最大值。

然后将鼠标放到刚刚操作的单元格的右下方，当鼠标变成黑色十字的时候双击，即可对这一列进行最大值操作。

得到最大值之后，将这一列的数据复制到新的sheet中，粘贴时如果出现错误，需选择右下角出现的复制选项，并选择粘贴数值。

选中这一列，点击插入->推荐的图表，从而得到光强分布的散点图，双击图表标题即可对其进行更改。

在Excel中，提供了初级的数据拟合功能，点击图像右上角的加号，会出现一系列图表元素，最底端即趋势线，鼠标浮动其上，右侧出现一个三角形，点击之后选择最下面的更多选项。

可以看到Excel中提供了指数、对数、线性、多项式以及移动平均等多种拟合曲线，可惜并没有我们需要的Gauss函数。

y = a ⋅ exp ⁡ ( − ( x − b c ) 2 ) y=a⋅\exp{(−(\frac{x−b}{c})^2)} y=a⋅exp(−(cx−b)2)

其中，a的值表示该函数的最大值；b表示其中心值，c表示当y值降到 1 e 2 \frac{1}{e^2} e21分之一处时x距离中心的位置。

然而，我们可以通过对原始数据进行简单的变换

ln ⁡ y = ln ⁡ a − ( x − b ) 2 c 2 ln ⁡ y = − x 2 c 2 + 2 b x c 2 + ln ⁡ a − b 2 c 2 \begin{aligned} \ln y&=\ln a-\frac{(x-b)^2}{c^2}\\ \ln y&=-\frac{x^2}{c^2}+\frac{2bx}{c^2}+\ln a-\frac{b^2}{c^2} \end{aligned} lnylny=lna−c2(x−b)2=−c2x2+c22bx+lna−c2b2

令 Y = ln ⁡ y , A = − 1 c 2 , B = 2 b c 2 , C = ln ⁡ a − b 2 c 2 Y=\ln y, A=-\frac{1}{c^2}, B = \frac{2b}{c^2}, C=\ln a-\frac{b^2}{c^2} Y=lny,A=−c21,B=c22b,C=lna−c2b2，则Gauss函数变为

Y = A x 2 + B x + C Y=Ax^2+Bx+C Y=Ax2+Bx+C

待拟合成功后，有 c = 1 − A , b = − B 2 A , a = exp ⁡ 4 A C − B 2 4 A c=\frac{1}{\sqrt{-A}},b=-\frac{B}{2A},a=\exp\frac{4AC-B^2}{4A} c=−A 1,b=−2AB,a=exp4A4AC−B2。

从而就可以进行多项式拟合了。

所以，首先在B1单元格中输入=LN(A1)，然后按照刚才的方法，将鼠标放置在单元格的右下角，待其变为黑色十字后双击，从而新建一列数据。

随后，对新建的数据仍然插入推荐的图表，并添加趋势线，然后在趋势线设置栏选中显示公式。

可见，由于存在大量光斑之外的数据，所以拟合效果并不好，所以需要对数据重新选择

在弹出的选择数据源窗口，重设图表数据区域。在本例中，将其设为=Sheet2!$B$50:$B$130。其中Sheet2为本sheet的名字，$B$50:$B$130表示B列第50行到B列第130行。

可见拟合效果好了很多，其中 A = − 0.0021 A=-0.0021 A=−0.0021， B = 0.1567 B=0.1567 B=0.1567， c = 1.5589 c=1.5589 c=1.5589，

根据 c = 1 − A , b = − B 2 A , a = exp ⁡ 4 A C − B 2 4 A c=\frac{1}{\sqrt{-A}},b=-\frac{B}{2A},a=\exp\frac{4AC-B^2}{4A} c=−A 1,b=−2AB,a=exp4A4AC−B2，可新开一个sheet，并在其中输入公式

	A	B
1	-0.0021	`=1/SQRT(-A1)`
2	0.1567	`=-A2/A1/2`
3	1.5589	`=EXP((4A1A3-A2^2)/A1/4)`

从而计算出c=21.82, b=37.31, a=88.42，但需要注意的是，我们刚刚在选取数据的时候，是从50开始的，所以b=50+37.31=87.31。