ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 6194|回复: 6

[求助] 请问如何用vba建立smartart呢?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-2-16 14:52 | 显示全部楼层 |阅读模式
如题如题,如果数据量很大的情况下,能够使用vba自动读取表格中的数据建立smart么?现在的主要问题还是如何将文字用vba写入到smartart中。我试了下录制宏,好像不行~>_<~,求各位大侠帮助啊~

TA的精华主题

TA的得分主题

发表于 2011-2-17 18:05 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

〖Excel Home友情提示〗

   

很遗憾通知楼上朋友,您的帖子在24小时之内没有任何回复!

通常情况下,本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复,其中的原因可能是

1、问题表述不清、模棱两可,难以理解,帮助者被搞晕了,夺帖而出;
2、没有上传必要的附件,或附件被遗忘在某个角落;
3、发帖提问时,语气带棱角、带挑衅,不幸被列入不受欢迎的帖子;
4、所提问题不成立,或提不合理的要求,乐于助人者使出“走为上”之计;
5、话题较偏、较冷或者发布到了不合适的版块,暂时无人问津,顾影自怜。


为了提高您的问题解决效率,我们推荐您阅读以下文章:
* 如何发表新话题和上传附件:http://club.excelhome.net/thread-45649-1-1.html
* 发帖的技巧:http://club.excelhome.net/thread-176339-1-1.html
* EH技术论坛的最佳学习方法:http://club.excelhome.net/thread-117862-1-1.html

TA的精华主题

TA的得分主题

发表于 2014-1-24 10:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
强中自有强中手啊,新人感谢

TA的精华主题

TA的得分主题

发表于 2020-8-12 11:30 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
最近刚研究了这个问题,楼主可以参考下我的代码,我这个代码的目的是为了实现自动生成单位组织架构图。这段程序可以自动把持股比例和单位名称复制到smartart的层次图里,并且根据公司的层级进行自动分级。代码如下:

  1. Sub Organization_Chart()
  2.     Dim saLayOut As SmartArtLayout
  3.     Dim sa As SmartArt
  4.     Dim LastRow As Long
  5.    
  6.     Range("J9").Select
  7.     LastRow = Range("B" & Rows.Count).End(xlUp).Row
  8.    
  9.     Set saLayOut = Application.SmartArtLayouts( _
  10.         "urn:microsoft.com/office/officeart/2005/8/layout/orgChart1")
  11.     Set oshp = ActiveSheet.Shapes.AddSmartArt(saLayOut)
  12.    
  13.     'add nodes to smartart
  14.     If LastRow > 4 Then
  15.         For i = 1 To LastRow - 5
  16.             With oshp
  17.                 .Select
  18.                 .SmartArt.AllNodes.Add
  19.             End With
  20.         Next i
  21.     Else
  22.         GoTo error
  23.     End If
  24.    
  25.     'put company name and equity ratio to smartart's nodes
  26.     For i = 1 To LastRow
  27.         With oshp
  28.         .Select
  29.             Set sa = .SmartArt
  30.             If Range("E" & i).Value = "" Then
  31.                 sa.AllNodes(i).TextFrame2.TextRange.Text = Range("B" & i).Value
  32.             Else
  33.                 sa.AllNodes(i).TextFrame2.TextRange.Text = Range("E" & i) & vbNewLine & Range("B" & i).Value
  34.             End If
  35.                
  36.             'At the beginning,set every company to level1
  37.             Do Until sa.AllNodes(i).Level = 1
  38.                 sa.AllNodes(i).Promote
  39.             Loop
  40.             'Reset the company to its correct level
  41.             j = VBA.CLng(Trim(Range("D" & i).Value)) - 1
  42.             
  43.             If j = 0 Then
  44.                 sa.AllNodes(i).Shapes.Fill.ForeColor.RGB = 15123099
  45.                 sa.AllNodes(i).TextFrame2.TextRange.Font.Fill.ForeColor.RGB = 0
  46.             Else
  47.                 For n = 1 To j
  48.                     'set the node's level according to its class column D
  49.                     sa.AllNodes(i).Demote
  50.                     sa.AllNodes(i).Shapes.Fill.ForeColor.RGB = 6567712 + j * 1500000
  51.                     sa.AllNodes(i).TextFrame2.TextRange.Font.Fill.ForeColor.RGB = 0
  52.                 Next n
  53.             End If
  54.         End With
  55.     Next i
  56.    
  57.     'adjust the shape
  58.     With oshp
  59.          .ScaleWidth 15, msoFalse, _
  60.         msoScaleFromTopLeft
  61.           .ScaleHeight 10, msoFalse, _
  62.         msoScaleFromTopLeft
  63.     End With
  64.    
  65.     'zoom the spreadsheet
  66.      ActiveWindow.Zoom = 50
  67.      
  68.      Exit Sub

  69. error:
  70.     MsgBox "至少要有5家单位!"
  71.      Exit Sub
  72.    
  73. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-8-27 10:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lyuleivip 发表于 2020-8-12 11:30
最近刚研究了这个问题,楼主可以参考下我的代码,我这个代码的目的是为了实现自动生成单位组织架构图。这段 ...

能提供表格吗?谢谢

TA的精华主题

TA的得分主题

发表于 2020-9-11 10:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
tanlifeng 发表于 2020-8-27 10:17
能提供表格吗?谢谢

不好意思哦,这个算是公司机密,我没法给

TA的精华主题

TA的得分主题

发表于 2024-9-10 09:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
lyuleivip 发表于 2020-8-12 11:30
最近刚研究了这个问题,楼主可以参考下我的代码,我这个代码的目的是为了实现自动生成单位组织架构图。这段 ...

谢谢,SmartArtLayouts的方法


_Application.SmartArtLayouts 属性 (Microsoft.Office.Interop.Excel) | Microsoft Learn  https://learn.microsoft.com/zh-c ... outs?view=excel-pia
定义
命名空间:
Microsoft.Office.Interop.Excel
程序集:
Microsoft.Office.Interop.Excel.dll
获取当前在应用程序中加载的 SmartArt 布局集。

C#

复制
public Microsoft.Office.Core.SmartArtLayouts SmartArtLayouts { get; }
属性值
SmartArtLayouts
当前在应用程序中加载的 SmartArt 布局集。

注解


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 23:00 , Processed in 0.033430 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表