Excel+VBA处理高斯光束
文章目录
- 1 图片导入与裁剪
- 2 获取图片数据
- 3 数据拟合
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 Byte
Dim width, height, stride As Long '分别位图像的宽, 高, 偏移
'获取bmp图片二进制数组
Open file For Binary As #1 '#1表示文件编号
ReDim bytes(LOF(1) - 1) '重新定义bytes的长度
Get #1, , bytes '将文件1的内容写入bytes
Close #1
For i = 0 To 3
start = start + bytes(i + 10) * 256 ^ i
width = width + bytes(i + 18) * 256 ^ i 'bitmap中第18-21位为列数
height = height + bytes(i + 22) * 256 ^ i 'bitmap中第22-25位为行数
Next
stride = width * 3 + 2
If (stride Mod 4) <> 0 Then
stride = stride - (stride Mod 4) + 4 'bitmap格式每行必须是4的倍数
End If
Cells.Clear
For i = 1 To height
For j = 1 To width
pos = start + (j-1) * 3 + (i - 1) * stride
Cells(i, j).Value = bytes(pos) '将像素的灰度值赋给单元格
Next
Next
End Sub
点击【加载数据】按钮，就可以看图像的数据被加载到单元格中。
若将赋值语句Cells(i, j).Value = bytes(pos)变成颜色变化，则可以通过单元格复现图像。
'...
For i = 1 To height
For j = 1 To width
pos = start + (j-1) * 3 + (i - 1) * stride
'将单元格的颜色变为图像的颜色
Cells(i, j).Interior.Color = RGB(bytes(pos + 2), bytes(pos + 1), bytes(pos))
Next
Next
点击加载数据，就可以看到如下情景
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=−A1,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=−A1,b=−2AB,a=exp4A4AC−B2，可新开一个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。