chrisfang的Excel大全
  • 【词频分析工具】使用说明

    2013-01-25
    1

    Excel词频分析工具,对中文文本进行断词分词,并且在Excel中统计显示词频。
    阅读全文 »

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 30,447 次浏览 | Tags:
  • 在VBA中调用调色板

    2012-10-03

    ————————————————以下原文发表于2010-1-16——————————————

    在有些程序中,需要向用户提供选择颜色的功能,调用Excel或Windows的调色板是一种比较理想的交互方式,关于在VBA中如何调用调色板,本人总结了以下几种方法:

    (以下程序以用户窗体中调用调色板修改Label1的标签字体颜色ForeColor为例)

    方法一:调用单元格格式中的“字体”选项卡对话框。

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    
    Private Sub CommandButton1_Click()
    '保存活动单元格当前字体格式设置
    With ActiveCell.Font
    x_name = .Name
    x_fontstyle = .FontStyle
    x_size = .Size
    x_Strikethrough = .Strikethrough
    x_Superscript = .Superscript
    x_Subscript = .Subscript
    x_OutlineFont = .OutlineFont
    x_Shadow = .Shadow
    x_Underline = .Underline
    x_ColorIndex = .ColorIndex
    End With
    dlg = Application.Dialogs(xlDialogActiveCellFont).Show '调用活动单元格字体设置选项卡对话框
    '************其他类似对话框*************
    'Application.Dialogs(xlDialogFontProperties).Show
    'Application.Dialogs(xlDialogFormatFont).Show
    'Application.Dialogs(xlDialogFont).Show
    'Application.Dialogs(xlDialogPatterns).Show '单元格底纹设置
    'Application.Dialogs(xlDialogReplaceFont).Show '查找替换对话框中的字体设置
    'Application.Dialogs(xlDialogStandardFont).Show
    '************************************
    If dlg = True Then
    Application.ScreenUpdating = False
    Me.Label1.ForeColor = ActiveCell.Font.Color
    '恢复活动单元格原有字体格式设置
    With ActiveCell.Font
    .Name = x_name
    .FontStyle = x_fontstyle
    .Size = x_size
    .Strikethrough = x_Strikethrough
    .Superscript = x_Superscript
    .Subscript = x_Subscript
    .OutlineFont = x_OutlineFont
    .Shadow = x_Shadow
    .Underline = x_Underline
    .ColorIndex = x_ColorIndex
    End With
    Application.ScreenUpdating = True
    End If
    End Sub

    这个方法的缺点是显示的对话框中不仅仅包含颜色设置,还有字体、加粗、斜体等等其他字体格式,虽然在代码中屏蔽了颜色以外的设置功能,但还是容易引起用户误解。当然,如果需要设置字体的更多格式,还是比较适合使用此方法。

    方法二:调用Excel中的“编辑颜色对话框”
    在Excel的选项设置中,有一项Excel调色板的设置(Excel2003菜单:工具—选项—颜色—修改),可以对Excel调色板中的56种颜色进行编辑修改自定义,此方法就是调用这里的编辑颜色对话框。

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    
    Private Sub CommandButton2_Click()
    oldcolor = ActiveWorkbook.Colors(1) '保存活动工作簿中调色板第一格的当前颜色
    If Application.Dialogs(xlDialogEditColor).Show(1) = True Then '调用编辑颜色对话框,选择的颜色将返回到调色板的第一格
    '************其上一级对话框,但不太适合使用*************
    'Application.Dialogs(xlDialogColorPalette).Show
    'Application.Dialogs.Item(xlDialogColorPalette).Show
    '*************************************************
    Me.Label1.ForeColor = ActiveWorkbook.Colors(1)
    ActiveWorkbook.Colors(1) = oldcolor '恢复活动工作簿调色板第一格的原有颜色
    End If
    End Sub

    这个方法是个人比较推荐的一种方法,操作简单。网上有不少地方都提到使用Application.Dialogs(xlDialogColorPalette).Show这个对话框,但从实际使用上来看,还是现在这个对话框(xlDialogEditColor)更合适。

    方法三:调用WindowsAPI,调用Windows的调色板。

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    
    Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
    End Type
    Private Type RGBColor
    R As Byte
    G As Byte
    B As Byte
    space As Byte '用作间隔
    End Type
    Private Declare Function ChooseColorA Lib "Comdlg32" (pChoosecolor As CHOOSECOLOR) As Long
    Dim CustColors(1 To 16) As RGBColor
    Private Sub CommandButton3_Click()
    Dim CColor As CHOOSECOLOR
    With CColor
    .lStructSize = Len(CColor) '结构长度
    .lpCustColors = VarPtr(CustColors(1)) '存储自定义颜色的缓冲区地址,CustColors为公共变量,用于保存自定义颜色,以便于用户下一次打开调色板时仍能够使用前一次的自定义颜色
    End With
    If ChooseColorA(CColor) = 0 Then Exit Sub '等于0表示按下了取消键
    Me.Label1.ForeColor = CColor.rgbResult
    End Sub

    此方法为API调用,调用的是Windows系统的调色板,稍显繁琐。
    其中CColor.lpCustColors指向16种自定义颜色的地址,如果要在程序运行过程中保存用户的自定义颜色,使得任何时候打开调色板都可以继续使用之前所定义的颜色,可以通过定义CustColors(1 to 16) As Byte为公共变量,然后使用VarPtr函数转换后将VarPtr(CustColors(1))赋值给CColor.lpCustColors。上面的代码中定义了类型RGBColor,主要用于方便程序处理中取得自定义颜色的RGB值,实际使用中并非必需。
    如果不需要保存自定义颜色,lpCustColors的赋值比较随意。

    方法四:使用CommonDialog控件,调用Windows调色板,需要系统控件支持。(Windows7中好像没有这个控件)

    1
    2
    3
    4
    5
    6
    7
    8
    
    Private Sub CommandButton4_Click()
    On Error GoTo zz
    Me.CommonDialog1.CancelError = True
    Me.CommonDialog1.ShowColor
    Me.Label1.ForeColor = CommonDialog1.Color
    Exit Sub
    zz:
    End Sub

    此方法也是调用Windows中的调色板,其缺点就是需要附带控件,Xp中一般都包含了CommonDialog控件。

    综合以上几种方法来看,个人比较推荐方法二,简单易行,而且使用的是Excel中的调色板,还可以自定义颜色。如果对API比较熟悉,也可以使用方法三。除此以外,也可以自己制作一个调色板窗体供用户选择颜色。例如下面这个John-Walkenbach的作品:
    http://spreadsheetpage.com/index.php/site/tip/creating_a_color_picker_dialog_box/

    本文附件下载:调用调色板 (954)

     

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 7,539 次浏览 | Tags:
  • 【2013图表样式】使用说明

    2012-07-19

    这是来自未来的图表,幸运的你现在就能享用到这一切。

     

    【2013图表样式】使用说明

     

    微盘下载:http://vdisk.weibo.com/s/8_uyI/1342702157

    本地下载:2013图表样式工具 (1311)

    有部分用户在其他地方下载此插件以后安装时Excel会报错,可以在上面这个链接里重新下载,这个链接当中的程序已修复上述错误。

     

    操作演示:

                                 
    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 2,781 次浏览 | Tags:
  • Excel八音盒

    2012-05-09

    这几天重感冒,做不了什么正经事,用以前的作品(《我爱弹钢琴》)改了一个趣味小程序。

    大家应该都见过八音盒吧,有人知道八音盒的原理吗?

    八音盒是通过长度或厚度不同的多个细小铜片(簧片)与携带针状突起的滚筒相互作用来发声的,最初是由瑞士的钟表匠发明的。

     

    Excel八音盒

    这个Excel小程序就是模拟了八音盒的发声原理,用表格单元格当作滚筒,用MIDI作为发声簧片。只要在表格单元格里输入数字作为滚筒上的打孔标记,就可以完成谱曲。没有条件自己来做八音盒的,现在也可以用Excel来模拟实现啦。

    谱一首属于你自己的动听乐曲,送给你心中的人吧。

     

    Excel八音盒

           Excel需要启用宏,记得打开音箱

    播放演示:

    微盘下载:http://vdisk.weibo.com/s/5a8Gt/1336546636

    本地下载:Excel八音盒 (1522)

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 4,145 次浏览 | Tags:
  • 【56色板】使用说明

    2012-05-03

      【56色板】是一款使用VB开发的Excel COM加载宏程序,适用于32位的Microsoft Excel 2007或2010版。可以在07以上版本的Excel中继续沿用2003版本中的56种色块的色板模式,对单元格、图形、图表等多种对象的填充色、字体颜色、线条色(边框色)进行即时设置,并且为用户提供了在线的庞大的配色方案库,方便用户进行颜色美化。

    【56色板】使用说明

    【程序设计说明】

    在2003版本当中,常用工具栏上的【填充颜色】、【字体颜色】等按钮中可以使用包含40种标准色的色板,如下图所示:

    【56色板】使用说明

    而在【单元格格式】、【设置自选图形格式】等对话框中则可以使用包含56种标准色的色板,如下图所示:

    【56色板】使用说明

     其实,在每个工作簿当中都包含了一套拥有56种颜色的颜色系统(可以随工作簿携带),在Excel的选项当中可以看到这些颜色的分类并且可以对其进行修改自定义,如下图所示。其中【图表颜色】就是Excel 2003当中自动生成图表是所采用的默认颜色来源。

    【56色板】使用说明

    可是在Excel 2007版以后,上面这些颜色的应用情况发生了变化。在Excel 2007和Excel 2010当中,采用【主题色】和【标准色】组合的方式形成可选色板。

    其中【主题色】包括八种可以自定义的颜色加上黑白两色形成10种基准色,然后由基准色的深浅度不同产生5×10种衍生色;而【标准色】则是一组包括红橙黄绿青蓝紫常见颜色的10种颜色。因此,虽然下面显示的色板有70个色块可选,但实际上真正的颜色只有20种,其中只有8种可以自定义。这对于用惯了老版本当中色板的用户来说会造成不小的麻烦。

    【56色板】使用说明

    当然,2007以上版本中的进步之处在于多了一种【其他颜色】的直接可选项,允许用户直接在工作簿中使用色板以外的颜色,因此在2007以上的版本中,工作簿当中的可容纳颜色种类高达1600万种。而对比2003版,虽然用户可以对色板体系中的56种颜色进行自定义,但任何时候工作簿中的显示颜色只能是色板上56种颜色中的其中一种,不能超出这个范围。因此对于2003版本来说,工作簿中的最大可容纳颜色种类只有56种。

    【56色板】使用说明

     

    Excel 2007和10版尽管可以选择更多颜色,但是从操作上来说,没有把更多的颜色种类直接放置在可选色板上,在使用效率上还是会造成一定的影响。
    【56色板】的程序设计,就是为了在2007和2010以及更高版本的Excel当中,不影响现有主题色体系的情况下,可以继续沿用2003当中的56种颜色色块的色板操作模式,并且在此基础上简化了自定义颜色的操作、并且设定了【工作簿】和【系统】两套颜色存储体系,方便用户自由的备份和携带自己所使用的颜色方案。
    这个程序设定的一个特别之处就是如果用户使用工作簿色彩存储体系,并且对颜色了自定义,然后又在工作簿中应用了这些颜色,那么即使将工作簿另存为2003格式,在2003的环境下打开这个工作簿,颜色显示能够依旧与原先保持完全一致(原有正常情况下,2007以上版本中所应用的一些颜色,到了2003里面打开时部分颜色就会呈现出另外的色彩)。
    除此以外,这个程序还提供了大量的【在线配色方案】供用户选取,这些配色方案是专门为本程序用户收集的国际专业配色站点上最受欢迎的一些方案,从中可以获取很多配色设计上的灵感。这些配色方案还会不定期的更新和增加,用户不需要更新程序也可以直接在联网的情况下获取到。

    【最新版本】:V1.3

    【更新历史】

    V1.0:内部测试版本
    V1.1:内部测试版本
    V1.2Demo:公开测试版本
    V1.2:内部测试版本
    V1.3:发布时间:2012-6-27
    1,工作簿色板和系统色板切换
    2,其他工作簿颜色导入
    3,填充色、文字色和线条色三种对象选择
    4,在线配色

     

    【使用前的设置】

    本程序是COM加载宏,需要在Excel程序中安装加载。如果你之前使用过此程序,再次安装前建议先行卸载,以免出现冲突。

    手动加载方法如下
    将下载文件包解压以后,把其中【56ColorsForExcel.DLL】这个主程序文件放置到一个相对固定的磁盘路径下,在加载安装后不要删除、更名或更改其路径。
    在Excel功能区上依次点击【文件】(2007版中是圆形的【Office按钮】)——【选项】(2007版中是下方靠右侧的【Excel选项】)——【加载项】,在出现的对话框下方的【管理】下拉框中选中【COM加载项】,然后点击【转到】,出现【COM】加载项的对话框。点击【添加】按钮会打开一个浏览器窗口,在里面找到56ColorsForExcel.DLL文件的所在,选中以后确定添加,就可以得到最终的【COM加载项】对话框,如下图所示。最后单击【确定】就可以完成这个加载项的安装。
    注意,加载过程中可能会出现某些安全程序的提示信息,在可以信任的情况下请允许程序的操作行为。(大多数COM加载项会在注册表中进行DLL注册的行为,此程序没有其他恶意或潜在威胁的操作)

    【56色板】使用说明

     

    如果需要卸载,只需要重新打开【COM加载项】对话框,选中这个加载项点击【删除】即可。
    如果手动安装失败,可以尝试下面的自动加载方法。
    自动加载方法如下
    将下载文件包解压以后,把整个文件夹放置到一个相对固定的磁盘路径下,在加载安装后不要删除、更名或更改其路径。关闭所有Excel程序,在文件包中找到【Install】的批处理文件,双击运行即可完成安装。部分安全软件可能会阻止运行,在您没有顾虑的前提下请允许运行。
    如果需要卸载则点击【Uninstall】的批处理文件。

    正确加载安装完成后,打开Excel程序后功能区上会出现【56色板】的选项卡,显示如下图:

     

    【56色板】使用说明

     最后补充说明一下,本程序只适合在32位的Windows系统上安装使用。对于64位,由于目前环境下.NET的程序在安装部署上存在诸多困难,被大多数XP用户所排斥。如果为此需要使用不同的开发程序编写两套软件,精力代价又过于庞大,因此暂时不考虑64位的发布。

    【程序使用说明】

    <色板使用>

    在选项卡的第一个命令组中,包含了【填充】、【文字】、【线条】三个下拉按钮,可以对选中的单元格、图形、图表中各类元素分别设置其填充底色、文字颜色和线条颜色。按钮左侧的色块显示了最近一次所使用的颜色,直接点击可以快速重复前一次的颜色设置。

    【56色板】使用说明

     

    <浮动面板>

    如果你需要进行一些连续的颜色设置操作,不希望一次次的去点击下拉按钮,那可以按下右侧第一排的【浮动面板】开关,会出现一个固定显示的色板,方便你直接从上面选择颜色。但是需要留意的是,浮动面板上需要通过三个选项按钮来确定颜色设置的对象。

    【56色板】使用说明

     

    <格式刷>
    右侧第二个按钮【格式刷】的功能与Excel本身的格式刷功能完全相同。用户在进行颜色设置等操作时,格式刷是非常有用的工具,把格式刷按钮放在这个工具面板当中方便用户直接调用,而不需要在其他选项卡之间反复来回切换。
    <颜色设置对话框>
    点击右侧第三个按钮【颜色设置】会出现一个提供用户进行颜色设置的对话框。点击每个色块会打开一个颜色设置窗口,可以自定义颜色来替换之前的颜色。

    【56色板】使用说明

     

    对话框上方有四个按钮。前两个是一组开关,可以在【工作簿色板】和【系统色板】之间切换。每个Excel工作簿都隐含了一套完整的56种颜色的色板体系,用户在这里设置的颜色可以随这个工作簿携带(即使将工作簿发给其他用户也不会丢失)。如果打开两个设置了不同色板的工作簿,可以使用不同的配色体系。

    使用工作簿色板体系的一个特别之处就是如果对此色板进行了自定义,并且在工作簿中应用了这些颜色,那么即使将工作簿另存为2003格式,在2003的环境下打开这个工作簿,颜色能够依旧保持完全一致(原有正常情况下,2007以上版本中所应用的一些颜色,到了2003里面打开时部分颜色就会呈现出另外的色彩)。
    除此以外,本程序还专门准备了一套【系统色板】,方便用户将自定义的颜色配置保存在计算机系统当中,即使打开不同的工作簿也可以使用同一套配色。方便用户将最喜爱最常用的配色方案便捷保存和调用。
    这两套色板在切换以后,功能区上的下拉按钮里面所显示的色块也会随之变化。
    第三个按钮是【从其他工作簿复制颜色】,可以直接将另外工作簿中的色板方案直接导入到当前工作簿当中覆盖。
    第四个按钮是【恢复默认】,点击后可以将当前选中的色板恢复到Excel原有默认的色彩排列方案。
    关于本软件颜色系统的使用奥妙,可以参考这个视频:

                          

    <在线配色方案>
    在线配色方案可为用户提供成百上千套专业的现成的配色方案(先期提供200套,陆续增加),方便用户直接使用。
    在联网状态下,可在【方案组】下拉框中选择组号,然后在【方案名】下拉框中选择具体的方案名称,右侧就会出现此配色方案中包含的各个色块。在【模式】中选择颜色的设置对象(这是三个单选开关按钮,首次点击后会保持按下状态),然后就可以直接点击右侧的色块进行颜色应用。

    【56色板】使用说明

     

    【程序下载】

    新浪微盘下载:http://vdisk.weibo.com/s/7FO06/1340771039

    本地下载:56色板V1.3版本 (842)

     

    【操作演示视频】

                               
    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 2,813 次浏览 | Tags:
  • Excel单元格绘图工具

    2012-04-09

    以前发在EHblog的老博文,现在关闭了,准备陆陆续续搬迁一点过来。时间久了,有些文章也不一定保值了。

    ————————————————以下原文发表于2010-3-17——————————————

    前日在网上闲逛时凑巧看到一个名为ExcelArt的软件介绍(http://www.cnbeta.com/articles/105787.htm),此软件可以将图片转换为Excel单元格图像,在Excel单元格中画图变得不再那么复杂,可以轻松按键搞定。去下载了试用了一下,非注册版有诸多限制,而且转换还以失败告终。去他们的主页看了一下,专业版竟然售价10欧元,企业版50欧元!

    看来还是自己动手做一个比较方便!
    用VBA制作的思路其实很简单,应该已经有先人实践过,只是没有见过成熟产品,所以发上来和大家一起分享一下。
    软件界面:

    Excel单元格绘图工具

    生成效果如下:

    Excel单元格绘图工具

    附件如下:请使用2007以上版本打开。

    微盘下载:http://vdisk.weibo.com/s/3Wdeh

    本地下载:单元格画图V2.1(96DPI) (1751)

     

    上述附件中的程序假定分辨率为96DPI,如需适用于其他的分辨率条件下,可以使用下面的附件程序,其中的坐标转换部分代码参考Winland大侠的代码。

    微盘下载:http://vdisk.weibo.com/s/3Wdla

    本地下载:单元格画图V2.0 (1442)

     

    主要部分代码如下:

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    
    '以下代码位于用户窗体UesrForm1之中:
    '撰写:chrisfang
    '网址:http://Club.ExcelHome.net
    '日期:2010-3-16 17:29:39
    Private Declare Function GetPixel Lib "gdi32" ( _
                                      ByVal hDC As Long, _
                                      ByVal x As Long, _
                                      ByVal y As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                                        ByVal lpClassName As String, _
                                        ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowDC Lib "user32" ( _
                                         ByVal hwnd As Long) As Long
    Public maxx, maxy
     
    '--------------------------------------------------------------------------------
    Private Sub CommandButton1_Click()
    Dim hwnd, hDC As Long
    If maxx = 0 Then
    MsgBox "请先选择尺寸规格!"
    Exit Sub
    End If
    hwnd = FindWindow(vbNullString, Me.Caption)
    hDC = GetWindowDC(hwnd)
    ThisWorkbook.Sheets(1).Range("A1:OJ300").Interior.Color = -1
    winx = (Me.Width - Me.InsideWidth) / 2
    winy = Me.Height - Me.InsideHeight - winx
    mx = (winx + Me.Image1.Left) * 4 / 3
    my = (winy + Me.Image1.Top) * 4 / 3
    'Application.ScreenUpdating = False
    For x = 1 To maxx
    For y = 1 To maxy
    iColor = GetPixel(hDC, mx + x * 4 / 3, my + y * 4 / 3)
    ThisWorkbook.Sheets(1).Cells(y, x).Interior.Color = iColor
    Next y
    Next x
    'Application.ScreenUpdating = True
    MsgBox "绘制完成!"
    End Sub
    '--------------------------------------------------------------------------------
    Private Sub CommandButton2_Click()
    filestoOpen = Application.GetOpenFilename _
    (FileFilter:="Microsoft Image Files (*.jpg;*.jpeg; *.bmp), *.jpg;*.jpeg; *.bmp", _
    MultiSelect:=False, Title:="选择图片文件")
    If TypeName(filestoOpen) = "Boolean" Then
    MsgBox "没有选择文件"
    GoTo ExitHandler
    Else
    Me.Image1.Picture = LoadPicture(filestoOpen)
    End If
    ExitHandler:
    End Sub
    '--------------------------------------------------------------------------------
    Private Sub OptionButton1_Click()
    If Me.OptionButton1.Value = True Then
    maxx = 200
    maxy = 150
    Call disparea(maxx, maxy)
    End If
    End Sub
    '--------------------------------------------------------------------------------
    Private Sub OptionButton2_Click()
    If Me.OptionButton2.Value = True Then
    maxx = 300
    maxy = 225
    Call disparea(maxx, maxy)
    End If
    End Sub
    '--------------------------------------------------------------------------------
    Private Sub OptionButton3_Click()
    If Me.OptionButton3.Value = True Then
    maxx = 400
    maxy = 300
    Call disparea(maxx, maxy)
    End If
    End Sub
    '--------------------------------------------------------------------------------
    Private Sub disparea(ByVal maxx As Integer , ByVal maxy As Integer )
    Application.ScreenUpdating = False
    Range (Cells(1, 1), Cells(1, maxx)).ColumnWidth = 0.54
    Range (Cells(1, 1), Cells(maxy, 1)).RowHeight = 5
    Range (Cells(1, 1), Cells(1, maxx)).EntireColumn.Hidden = False
    Range (Cells(1, 1), Cells(maxy, 1)).EntireRow.Hidden = False
    Range (Cells(1, maxx + 1), Cells(1, 16384)).EntireColumn.Hidden = True
    Range (Cells(maxy + 1, 1), Cells(1048576, 1)).EntireRow.Hidden = True
    Me.Image1.Left = Me.Image1.Left + (Me.Image1.Width - maxx) / 2
    Me.Image1.Top = Me.Image1.Top + (Me.Image1.Height - maxy) / 2
    Me.Image1.Width = maxx
    Me.Image1.Height = maxy
    Application.ScreenUpdating = True
    End Sub

     

     

    ————————————————以下更新于2012年5月29日——————————————

    微博上最近有一个有关招聘的段子很火爆,说是办公室文员招聘,面试的题目竟然是用Excel画一幅超级玛丽!

     Excel单元格绘图工具

    呵呵,其实这是老段子啦,不过这次的情况貌似特别欢乐,有很多网友热烈响应,纷纷在Excel上亲手效仿练习起来。

    Excel单元格绘图工具

    这些闲的可爱的宅男宅女们啊!我知道,有这样现成一个程序可以自动实现单元格绘图对他们来说其实毫无意义,乐趣其实就在于玩弄格子的过程中,甚至可以洗却平日里被格子玩弄的种种不快。

    不过这也不影响我在上面程序基础上修改了一个更简单的版本,不为别的,独乐不如众乐,就让这欢乐来的更蛋疼些吧。

    程序原理其实很简单,甚至不值得一提:就是在图片上按XY坐标依次提取像素点的色彩值(根据精细程度,可能会忽略一部分像素点),填充到相应位置的Excel单元格中即可。

    由于Excel 2003版本中行列数比较少(只有256列),可用像素点就比较少,而且可用颜色也不丰富,因此这个单元格绘图的功能一般还是在Excel 2007以上的版本中来实现的。如果对清晰度要求不高,就好比像“超级玛丽”这种早期8位机上的马赛克图形画面,就只要很少的格子就可以实现了。这种马赛克级别的像素图绘制程序,也可以拿来作为十字绣的图稿定制。

    Excel单元格绘图工具

                          

     

    微盘下载:http://vdisk.weibo.com/s/5T6Hi/1337935234

    本地下载:Excel像素图 (937)

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 1,311,663 次浏览 | Tags:
  • 【调色板】使用说明

    2012-03-01

    【调色板】加载宏,是一款使用Xcelsius水晶易表结合ExcelVBA所开发的加载宏,适用于2003~2010版。可以用于Excel中的颜色自定义,可以对单元格、图形、图表等多种对象的填充色、字体颜色、线条色(边框色)进行所见即所得的即时设置,并且提供了渐变色系等强大的辅助配色功能。

    此版本为Excel版本,专为Excel所用,如需PPT版本可点击这里:《【调色板】PPT版使用说明

    【调色板】使用说明

    对比Excel系统本身自带的色板来说,这款工具的主要优势在于:

    1,操作步骤简化。

    不需要选定对象以后再去分别查找不同的菜单命令和选项,设置不同的参数。最简单的情况下只需要一个按键就可以完成不同对象的色彩设置需求。
    2,所见即所得。

    系统自带的色板中,要使用“主题颜色”和“标准颜色”以外的“其他颜色”时,需要打开配色面板,所选择的颜色不能即时反映到表格对象中。而使用本工具所有设置颜色的过程中,都可以即时反映到表格对象上。
    3,辅助配色。

    这款工具携带了高度自由的RGB和HSB两种模式的滑块式调色功能,除此以外还提供了【渐变色】体系的辅助色系供用户选择使用。用户不需要掌握更多的配色知识就能直接运用到工具中所提供的便捷的辅助配色。

    【开发特点】:

    这款工具使用了水晶易表的建模和控件所生成的Flash文件作为Excel加载宏的界面和功能载体。最后由VBA完成组装和功能调用。整个工具的大部分开发过程都是通过水晶易表中的函数公式所完成,只在最后的Excel加载调用时使用了少量的代码。并且其中的Flash模块可以分离出来作为其他软件的独立功能模块。
    这是一个水晶易表制作的Flash与Excel的完美结合,充分利用了水晶易表在交互界面上的美观优势、模块逻辑设计上的简单易行。最后再结合ExcelVBA的强大综合能力。整个设计开发过程大大降低了开发者的门槛和难度。

    【最新版本】:V3.0

    【更新历史】:
    V1.0:内部测试版本
    V2.0:发布日期2012年2月27日
    1,基准色选择
    2,RGB和HSB滑块调节
    3,填充色、文字色和线条色三种对象选择
    4,中英文菜单选择
    2.0版界面图如下:

    【调色板】使用说明

    V3.0:发布日期2012年3月1日
    1,增加【渐变色】系选择,包括相邻色、深浅色、明暗色。
    2,增加在线帮助
    3,单独制作了2007和2010版的加载宏,可以生成独立的Excel选项卡菜单

    【使用前的设置】:

    本程序是加载宏,需要在Excel程序中安装加载,具体操作方法可参考(方法不复杂,两步就完成):《加载宏(Addin)使用方法
    2007和2010版的用户可以加载使用《调色板v3.0_for2003》,也可以使用专为07和10版设计的《调色板v3.0_for2007&2010》。如果你之前使用过2.0版,建议先行卸载,以免出现冲突。

    本插件调用了Flash模块,需要系统中支持Flash,通常情况下您的系统如果能够正常显示网页动画,一般都已经包含了Flash播放器插件。但如果您的系统中没有包含这部分功能,则会影响到此工具的正常运作(无法加载显示)。如果要添加Flash播放器,可联机到Adobe的官方站点中下载安装:http://get.adobe.com/cn/flashplayer/

    由于Flash安全设置方面的原因,初次运行本插件时有可能出现错误,请关闭Excel程序后重新打开再尝试。在某些情况下,插件使用时如果提示“无法访问外部数据”的错误,可以照错误提示中的方法进行设置,也可以点击运行这个文件包当中的“Flash安全配置”批处理文件。

    【程序使用说明】:

    以Excel2010版本为例,在正确加载此插件以后,会在Excel功能区中出现【调色板】选项卡,显示如下:

    【调色板】使用说明

    在【调色板】选项卡中点击【我的调色板】命令按钮以后就会出现上图中的面板。
    在面板中主要包含这几部分功能模块:
    【菜单语言选择】:可以选择英文或中文菜单显示,流行语谓之:与国际接轨

    【调色板】使用说明

    【基准色选择】:可以在12种基准色(包括黑色和白色)当中直接选择。这12种基准色是在Excel色板中和许多其他软件中常见的标准颜色。这是一个滑动展示框,鼠标向左右两侧边缘移动时会自动显示更多的按钮。在这里选择某个颜色以后,下方的大正方形色块中就会显示当前选中的颜色,并且根据【选择对象】的类型,与当前Excel表格中所选取的对象匹配其颜色属性。

    【调色板】使用说明

    例如,假定当前【选择对象】的选项按钮中选中了【填充色】,而当前表格中所选取的是A1单元格,那么每次选择不同的基准色块,就会改变A1单元格的背景颜色。

    【调色板】使用说明

    在这里特别需要注意的是:这个工具应用颜色的激活标志是大正方形中的颜色是否发生改变,如果前一次所选择的色块和这一次所选择的是相同颜色,大正方形中的颜色没有发生丝毫变化,这样就不会把这个颜色应用到当前选中的对象中。因此,如果要对两个不同的对象分两次应用相同的颜色,在后一次操作前,需要先更改一下所选择的颜色(也可以调节下方的滑动块),使得正方形中的颜色发生改变。

    【RGB调节】和【HSB调节】:在选项按钮中选中【RGB】的前提下,可以通过RGB滑块来自定义颜色。RGB是常用的红绿蓝三色分量模式,可以把一种颜色通过这三种分量的含量多少来表示。可以通过RGB三个分量滑块的调节来改变颜色,改变的范围在0~255之间。在调节滑块的同时,大正方形色块中会即时显示配色结果,并会直接应用在当前表格中所选中的对象上。        

    【调色板】使用说明

     在RGB选项选中的时候,更改下方的HSB滑块不会产生直接变化,此时的HSB滑块是被锁定的。

    在选项按钮中选中【HSB】的前提下,才能通过HSB模式来调整自定义颜色。HSB是通过色调、饱和度和明度三种维度来描述色彩的一种方式。其中色调的数值范围在0~360之间,饱和度和明度的数值都在0~100之间,表示程度的百分比。通过HSB的调节,可以很方便地得到相邻色和深浅、明暗程度比较接近的各种不同色阶的色彩。

    【渐变色】:渐变色是本工具提供的一个智能辅助功能,可以帮助用户自动生成与当前选中的颜色相匹配的近似颜色。其中包括三种模式:相邻色、深浅色和明暗色。以及可以设置渐变强度大小的滑块(强—弱)。

    <相邻色>表示左右两侧的颜色是与中间色块在色相上处于相邻位置。例如下图所示:

    【调色板】使用说明

    所谓色相的位置,可以参考下面的色相环图片:

    【调色板】使用说明

    <深浅色>表示通过增减饱和度分量来取得基色的不同演变色,在视觉上可以呈现不同深浅程度的效果。例如下图所示:

    【调色板】使用说明

    <明暗色>表示通过增减明度分量来取得基色的不同演变色,在视觉上可以呈现出不同明暗程度的效果。例如下图所示:

    【调色板】使用说明

    右上方的【强—弱】滑块可以调节渐变的强度,弱表示渐变的变化间隔较微弱,而强则表示渐变颜色的变化比较强烈。

    需要注意的是:在渐变色中,每点击选择一次色块,只要与前一次所选择的颜色有差别,就会改变大正方形中的显示颜色,同时影响表格中的选择对象,与此同时,渐变色色块本身也会同时发生变化,它会智能地反映当前选中颜色的相关渐变色(当前选中颜色始终位于中间第四个色块中)。因此假设你要依次选取某一个颜色的每一个相邻的色阶,你就需要每次都点击其中的第三个或第五个色块。

    如果将渐变色与下方的HSB手动调节滑块相互配合,还能玩出更多花样:

    渐变中选相邻色,下方调节饱和度或明度;渐变中选深浅色,下方调节色调或明度;渐变中选明暗色,下方调节色调或饱和度。这样就可以显现多种元素的叠加,形成更多色阶。

    【程序下载】:

    新浪微盘下载:http://vdisk.weibo.com/s/2T12M/1330589639

    本地下载:调色板Excel版 (976)

    【操作演示视频】:

    http://www.56.com/u38/v_NjY2MDI2NTE.html

           

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 3,898 次浏览 | Tags:
  • 【中文语义分词工具】小程序

    2012-02-09

    中文语义分词工具

    效果图:

    中文分词第三版

    中文分词 (Chinese Word Segmentation) 指的是将一个汉字序列切分成一个一个单独的词。分词就是将连续的字序列按照一定的规范重新组合成词序列的过程。我们知道,在英文的行文中,单词之间是以空格作为自然分界符的,而中文只是字、句和段能通过明显的分界符来简单划界,唯独词没有一个形式上的分界符,虽然英文也同样存在短语的划分问题,不过在词这一层上,中文比之英文要复杂的多、困难的多。

    阅读全文 »

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 6,898 次浏览 | Tags:
  • VBA中实现数组排序的多种方法

    2012-01-18

    VBA里面没有现成的Sort方法可以使用,在ExcelVBA里面要对数组进行排序,现有的通常做法:
    1,通过单元格赋值以后利用工作表里的Sort方法进行排序,
    2,通过SQL实现,也需要调用单元格区域存放数据,
    3,直接写循环语句通过算法来实现。

    除了上述方法以外,借助一些其他语言工具与VBA相结合,也能利用现成的排序功能来实现数组排序,而不需要借助表格。
    例如JavaScript:

    JavaScript里面也有Sort方法,可以拿来现成使用,示例代码如下:

    1
    2
    3
    4
    5
    6
    7
    8
    9
    
    Sub 文本升序()
    Set js = CreateObject("msscriptcontrol.scriptcontrol")
    js.Language = "javascript"
    arr = Application.Transpose(Range("A1:A10"))
    temp = Join(arr, ",")
    js.addcode "function aa(bb){js=bb.split(',');js.sort();return js;}"
    sortarr = js.eval_r("aa('" &amp; temp &amp; "')")
    Debug.Print sortarr
    End Sub

     

    1
    2
    3
    4
    5
    6
    7
    8
    9
    
    Sub 文本降序()
    Set js = CreateObject("msscriptcontrol.scriptcontrol")
    js.Language = "javascript"
    arr = Application.Transpose(Range("A1:A10"))
    temp = Join(arr, ",")
    js.addcode "function aa(bb){js=bb.split(',');js.sort();js.reverse();return js;}"
    sortarr = js.eval_r("aa('" &amp; temp &amp; "')")
    Debug.Print sortarr
    End Sub

     

    1
    2
    3
    4
    5
    6
    7
    8
    9
    
    Sub 数值升序()
    Set js = CreateObject("msscriptcontrol.scriptcontrol")
    js.Language = "javascript"
    arr = Application.Transpose(Range("A1:A10"))
    temp = Join(arr, ",")
    js.addcode "function aa(bb){js=bb.split(',');js.sort(function(a,b){return a-b;});return js;}"
    sortarr = js.eval_r("aa('" &amp; temp &amp; "')")
    Debug.Print sortarr
    End Sub

     

    1
    2
    3
    4
    5
    6
    7
    8
    9
    
    Sub 数值降序()
    Set js = CreateObject("msscriptcontrol.scriptcontrol")
    js.Language = "javascript"
    arr = Application.Transpose(Range("A1:A10"))
    temp = Join(arr, ",")
    js.addcode "function aa(bb){js=bb.split(',');js.sort(function(a,b){return a-b;});js.reverse();return js;}"
    sortarr = js.eval_r("aa('" &amp; temp &amp; "')")
    Debug.Print sortarr
    End Sub

     

    .NET里面有SortedList类也可以用来实现排序,但需要系统支持Framework

     

    1
    2
    3
    4
    5
    6
    7
    8
    9
    
    Sub Sortlist()
    Set objSortedlist = CreateObject("System.Collections.Sortedlist")
    For i = 1 To 10
    objSortedlist.Add Range("A" &amp; i).Value, Range("A" &amp; i).Value
    Next i
    For i = 0 To objSortedlist.Count - 1
    Debug.Print objSortedlist.GetKey(i)
    Next
    End Sub

     
    除了SortedList类,还有ArrayList也可以用

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    
    Sub Arraylist()
    Set objArrayList = CreateObject("System.Collections.ArrayList")
    For i = 1 To 10
    objArrayList.Add Range("A" &amp; i).Value
    Next i
    objArrayList.Sort
    For i = 0 To objArrayList.Count - 1
    Debug.Print objArrayList(i)
    Next
    End Sub

     
    还有其他什么好方法,欢迎大家支招。

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 7,227 次浏览 | Tags:
  • 【天气预报】小程序

    2012-01-10

    Excel版的天气预报软件,通过网络查询国内主要城市的最近两天内天气预报。用户只需要输入中文的城市名称,然后点击按钮就可以实时显示天气预报信息。天气类型会显示图标,气温会显示在温度计上,风向和风力会显示在指南针罗盘上。如果在需要输入的城市名称单元格处留空,则程序会自动判断用户所在城市,查询显示当地的天气预报。

    天气预报数据来源自中国天气网www.weather.com.cn

    此程序需要联网,需要启用宏。建议使用2007以上版本打开。

    【天气预报】小程序

     

    程序下载:

    华为网盘下载:http://dl.dbank.com/s0t7b3vike

    本地下载:天气预报工具 (914)

    作者: chrisfang | 分类: ExcelVBA程序 | 阅读: 2,374 次浏览 | Tags: