在Excel 2016 VBA中用ChemDrawControl16提取SMILES至单元格的代码实现

嘿，刚好我之前做过类似的需求，给你一步步拆解实现方法，非常简单：

你已经完成了最麻烦的控件配置环节，接下来只需要给命令按钮加几行VBA代码就能搞定，具体步骤如下：

1. 打开命令按钮的代码编辑界面 #

右键点击UserForm上的命令按钮，选择「查看代码」，VBA编辑器会自动跳转到该按钮的Click事件代码块。

2. 粘贴核心代码 #

把下面这段代码复制进去（注意替换控件名称，后面会解释）：

Private Sub CommandButton1_Click()
    Dim cdDoc As ChemDraw16Ctl.Document
    Dim targetCell As Range
    
    ' 获取ChemDraw控件里的文档对象
    Set cdDoc = ChemDrawControl1.Object.Document
    
    ' 先检查有没有绘制分子结构
    If cdDoc.Selection.Count = 0 Then
        MsgBox "请先在ChemDraw控件里画个分子哦！", vbExclamation
        Exit Sub
    End If
    
    ' 定位到当前工作表A列的第一个空白单元格（可以按需修改）
    Set targetCell = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
    ' 提取SMILES并写入单元格
    targetCell.Value = cdDoc.Selection.SMILES
    
    ' 释放对象，避免内存占用
    Set cdDoc = Nothing
    Set targetCell = Nothing
End Sub

3. 关键细节说明 #

• 控件名称匹配：代码里的ChemDrawControl1是默认的控件名称，如果你的控件改了名字（比如在属性窗口里改了Name），一定要把这里改成对应的名称。
• SMILES提取逻辑：cdDoc.Selection.SMILES是提取选中区域的结构SMILES，如果想提取整个控件里的所有结构，直接用cdDoc.SMILES就行，不用加Selection。
• 目标单元格修改：代码里默认是A列第一个空单元格，如果你想指定固定单元格（比如B2），改成Set targetCell = ThisWorkbook.ActiveSheet.Range("B2")就行。
• 错误防护：加了判断如果没选中结构就弹提示，避免出现运行错误。

4. 测试验证 #

回到UserForm界面，按F5运行窗体，在ChemDraw控件里画个简单分子（比如苯环），点击命令按钮，就能看到SMILES自动填充到指定单元格啦。

内容的提问来源于stack exchange，提问作者Benjamin Leuthold