Excel+VBA处理高斯光束

1 图片导入与裁剪

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

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

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

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

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

2 获取图片数据

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

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

然后右键按钮->【指定宏】，在弹出的对话框中添入【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\cdot \exp (-(\frac{x-b}{c}{)}^2)$$

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

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

$$\begin{array}{rl}\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{array}$$

令$Y=\ln y,A=-\frac{1}{c^2},B=\frac{2b}{c^2},C=\ln a-\frac{b^2}{c^2}$，则Gauss函数变为

$$Y=A{x}^2+Bx+C$$

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

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

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

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

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

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

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

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

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

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