使用Excel中的VBA宏从NCI化学标识符解析器检索化学结构图像

基于（见下文）中给出的代码，我想修改一些VBA Excel宏，以便使用位于的NCI化学标识符解析器将化学名称转换为Excel中的化学结构

特别是，我想扩展代码，使其具有一个额外的函数来返回结构的图像（GIF），结构的图像应该从中检索

  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image", False

然后应将其保存在Excel工作表中调用公式的位置（可能还会调整行大小以适应返回的图像）。有没有想过如何做到这一点

任何建议都将不胜感激

干杯， 汤姆

Private函数条（ByVal str作为字符串）作为字符串
暗淡的最后
对于i=1到Len（str）步骤1
如果Asc（Mid（str，i，1））<33，则
last=i
如果结束
接下来我
如果last>0，则
带=中间（str，1，最后-1）
其他的
strip=str
如果结束
端函数
公共函数getSMILES（ByVal名称作为字符串）作为字符串
Dim XMLhttp:Set XMLhttp=CreateObject（“MSXML2.ServerXMLHTTP”）
XMLhttp.setTimeouts20002000200020002000
XMLhttp.Open“GET”http://cactus.nci.nih.gov/chemical/structure/“+name+”/smiles”，False
XMLhttp.send
如果XMLhttp.Status=200，则
getSMILES=strip（XMLhttp.responsetext）
其他的
getSMILES=“”
如果结束
端函数
公共函数getInChIKey（ByVal名称作为字符串）作为字符串
Dim XMLhttp:Set XMLhttp=CreateObject（“MSXML2.ServerXMLHTTP”）
XMLhttp.setTimeouts 1000，1000，1000，1000
XMLhttp.Open“GET”http://cactus.nci.nih.gov/chemical/structure/“+name+”/stdinchikey”，False
XMLhttp.send
如果XMLhttp.Status=200，则
getInChIKey=Mid（strip（XMLhttp.responsetext），10）
其他的
getInChIKey=“”
如果结束
端函数
公共函数getIUPAC（ByVal名称作为字符串）作为字符串
Dim XMLhttp:Set XMLhttp=CreateObject（“MSXML2.ServerXMLHTTP”）
XMLhttp.setTimeouts 1000，1000，1000，1000
XMLhttp.Open“GET”http://cactus.nci.nih.gov/chemical/structure/“+name+”/iupac_name”，False
XMLhttp.send
如果XMLhttp.Status=200，则
getIUPAC=strip（XMLhttp.responsetext）
其他的
getIUPAC=“”
如果结束
端函数
公共函数getCAS（ByVal名称作为字符串）作为字符串
Dim XMLhttp:Set XMLhttp=CreateObject（“MSXML2.ServerXMLHTTP”）
XMLhttp.setTimeouts 1000，1000，1000，1000
XMLhttp.Open“GET”http://cactus.nci.nih.gov/chemical/structure/“+name+”/cas”，False
XMLhttp.send
如果XMLhttp.Status=200，则
getCAS=Mid（XMLhttp.responsetext，1，InStr（XMLhttp.responsetext，Chr（10））-1）
其他的
getCAS=“”
如果结束
端函数
公共函数getCASnrs（ByVal名称作为字符串）作为字符串
Dim XMLhttp:Set XMLhttp=CreateObject（“MSXML2.ServerXMLHTTP”）
XMLhttp.setTimeouts 1000，1000，1000，1000
XMLhttp.Open“GET”http://cactus.nci.nih.gov/chemical/structure/“+name+”/cas”，False
XMLhttp.send
如果XMLhttp.Status=200，则
getCASnrs=Replace（XMLhttp.responsetext，Chr（10），“；”）
其他的
getCASnrs=“”
如果结束
端函数
公共函数getSYNONYMS（ByVal名称作为字符串）作为字符串
Dim XMLhttp:Set XMLhttp=CreateObject（“MSXML2.ServerXMLHTTP”）
XMLhttp.setTimeouts 1000，1000，1000，1000
XMLhttp.Open“GET”http://cactus.nci.nih.gov/chemical/structure/“+name+”/names”，False
XMLhttp.send
如果XMLhttp.Status=200，则
getSYNONYMS=Replace（XMLhttp.responsetext，Chr（10），“；”）
其他的
getSYNONYMS=“”
如果结束
端函数

您可以使用与以下类似的方法获取图像：

    Sub Run()
getImage ("iron")
End Sub

Public Function getImage(ByVal name As String) As String
  Dim imgURL As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  imgURL = "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image"

  XMLhttp.Open "GET", imgURL, False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
   'It exists so get the image
    Sheets(1).Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 250, 250
  Else
    '
  End If
End Function

我相信这可以进一步简化为仅使用

Sheets(1).Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300

而不是下载图像两次，并简单地使用一个错误处理程序捕捉图像时没有找到

参考资料：

更新：

使用activesheet，宽度和高度为300像素：

 ActiveSheet.Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300

---

在

getSMILES

函数中，url前面有一个空格，如果删除该空格，那么它应该可以工作。。。而且

getInChIKey

对我来说还可以。

getIUPAC

对我来说也可以。你收到了什么错误？哈，很抱歉，删除了空间，现在一切都正常了，其他错误也奇迹般地消失了。你对我的另外两个问题有什么想法吗？这里有一个链接描述了如何从互联网下载PNG文件，希望你能修改它？插入图片不应该是一个问题，因为你可以只记录一个宏，然后查看代码以获得提示。另外，你应该试着一次只发布一个问题：-）嘿！非常感谢这一点-刚刚用getImage（“geraniol”）尝试过，但它只显示了一个空行。有什么想法吗？可能有什么问题？确实给你的图像虽然…哈抱歉，它下载了图像，但它没有把它在活动表，但只是在第一页。我应该如何改变这种行为，以便它将它放在活动表中放置公式的地方，放在放置公式的单元格的位置？（也可以根据需要调整调用公式的单元格的行高，使行与内容相匹配，以防需要将许多结构放置在彼此下方？）（也可以将图片大小调整30%左右，以使分辨率在屏幕上显示得更好）@Tom Wenselers您可以使用

ActiveSheet

变量获取活动工作表。例如，用50个像素加上宽度和高度：

ActiveSheet.Shapes.AddPicture imgURL，msoFalse，msoTrue，100100300300

非常感谢-事实上，我不完全确定它应该是活动表-它应该是调用公式的表-还是始终与活动表相同？

 ActiveSheet.Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300