【办公自动化】Excel中用vba生成Gis表达式cal文件

6月20日发的【办公自动化】Excel“一键”生成国土“三调”转换代码，介绍了通过转换对照Excel表加载bas代码文件，生成python脚本代码，粘贴至GIS中使用的方法。
最近做了一个尝试，用VBA直接生成包含python脚本代码的表达式cal文件，这样省去了复制粘贴再保存的事情。

相关文章：【三调转换】Excel“一键”生成升级了

1、操作看过来

• 打开三调转换对照表Excel，已更新至 三调转换对照表3.0.xlsx（后文获取）
• 快捷键 Alt+F11 打开了Excel的VBA编辑器

• 点文件 > 导入文件…
• 对话框中选到 excel转换代码2.0.bas文件，打开（后文获取）
• 按F5 或者点绿色箭头运行，出现下面宏对话框，有宏名称就加载正确
  
• 若选生成代码，和第一版一样，会自动弹出一个Word，里面是生成的Python代码，已全选，复制去GIS粘贴就行。

• 选生成cal文件，点运行，会弹出保存文件对话框，选择文件保存目录，输入文件名，点保存，就生成了cal文件。

• GIS中，可根据需要添加需要字段；
• 打开字段计算器…，选Python，点加载…选择生成的cal文件

注意：由于是非GIS生成的cal文件，存在格式问题，请在代码框删除第一行空白行里隐藏的格式内容，否则会报错，这里很奇怪，第一行明明什么都没有，点第一行多按两下Backspace就好了，看错误日志才发现还有这奇怪问题，总是在line0行报错

• 点确定就生成了转换后的数据，成功后记得重新保存个，下次就直接使用了
  
  2、想改怎么办

最新代码是通过判断表中C列的值，对应生成E+F的名称，与其他列无关，

• 需要表中其他标准的可以将其他列粘贴至E和F列；
• 需要其他地方标准可以自行修改表中E和F列内容；
• 只需要用地编码的转换文件可删除F列内容保留E列即可；
• 只需要用地名称的转换文件可删除E列内容保留F列即可。

3、聊聊代码

了解VB代码的同学可以根据需要自行修改，供交流学习！
以下生成代码函数
VBA是可以使用中文名作为函数名的，这样做选择题就方便多了。通过表格里的内容自动逐行编写python脚本代码，然后打开word写入其中，很方便。

Public Sub 生成代码()
Dim wdapp As Object
'准备python创建函数代码
cord = "def plan_name(name): " & vbCrLf & "    if 'K ' in name:" & vbCrLf & "        name = name[:-1]" & vbCrLf

' 循环生成判断代码
For Row = 2 To Cells(Rows.Count, "c").End(xlUp).Row
    Name = Cells(Row, "e") + Cells(Row, "f")
    If Row = 2 Then
    cord = cord & "    if name == '" & Cells(Row, "c") & "' : " & vbCrLf & "        return '" & Name & "'" & vbCrLf
    Else
    cord = cord & "    elif name == '" & Cells(Row, "c") & "' : " & vbCrLf & "        return '" & Name & "'" & vbCrLf
    End If
Next
'生成代码结尾，没有else结尾Gis中会报错
cord = cord & "    else:" & vbCrLf & "        return  'check '"

' 链接word
Set wdapp = CreateObject("word.application")
wdapp.Documents.Add  '新建页面
wdapp.Visible = True     ' 显示页面
wdapp.Selection = cord  '加入代码并选择

End Sub

以下生成cal文件函数
不同的是python脚本结尾增加了cal文件的调用函数代码，就是Gis里Layer = 下面框里要自己的填的那段调用函数代码
跳出一个保存文件选择窗口，方便获取路径和文件名，然后就是保存Gis能正确读取的文件，创建文件尝试了几种代码，开始加载后都是乱码，考虑到是编码的问题，用文本编辑器尝试转换了几次编码，发现是Unicode编码格式，最后采用了 CreateObject(“adodb.stream”)，里面可以设置编码格式。

Public Sub 生成cal文件()
'准备python创建函数代码
cord = vbCrLf & "def plan_name(name):" & vbCrLf & "    if 'K' in name:" & vbCrLf & "        name = name[:-1]" & vbCrLf

'循环生成判断转换代码
For Row = 2 To Cells(Rows.Count, "c").End(xlUp).Row
    Name = Cells(Row, "e") + Cells(Row, "f")
    If Row = 2 Then
    cord = cord & "    if name == '" & Cells(Row, "c") & "' : " & vbCrLf & "        return '" & Name & "'" & vbCrLf
    Else
    cord = cord & "    elif name == '" & Cells(Row, "c") & "' : " & vbCrLf & "        return '" & Name & "'" & vbCrLf
    End If
Next

'生成代码结尾，没有else结尾Gis中会报错，看到check行说明有没转换的用地
cord = cord & "    else:" & vbCrLf & "        return  'check '"
'增加cal文件调用代码
cord = cord & vbCrLf & vbCrLf & "__esri_field_calculator_splitter__" & vbCrLf & "plan_name(!DLBM!)"

'选择保存文件目录和文件名称
Path = Application.GetSaveAsFilename(FileFilter:="表达式(*.cal),*.cal", Title:="保存文件")

'创建文件
Set Stream = CreateObject("adodb.stream")
Stream.Open
Stream.Charset = "Unicode"  'Gis里加载的文件得是Unicode格式的
Stream.writetext cord       '写入文本
Stream.savetofile Path, 2   '保存路径，2为可覆盖
Stream.Close

End Sub

8月12日最新发布GIS转换工具箱，转换文件已停止更新
对原转换文件感兴趣的同学可以点击下方网盘链接
链接：https://pan.baidu.com/s/1fIaDrvwfElGWeqtqwAyZWg
提取码：0817

需要CAD图层生成相关文件的同学，
关注公众号，回复“图层”，自动发送链接

相关文章：【三调转换】Excel“一键”生成升级了