EXCEL VBA:如何获取单元格格式?

2013-07-19 14:24 阅读 736 次 评论关闭

Sub 工作表设置()
Dim Mdyggs(52) As Variant  '定义一个变型数组
Mdyggs(51) = Sheet1.UsedRange.Rows.Count     '有效行
Mdyggs(52) = Sheet1.UsedRange.Columns.Count  '有效列
Mgzbm = "Sheet1"   '定义工作表
Mdygm = "A1"       '定义单元格
'获取工作表格式
Mdyggs(1) = Worksheets(Mgzbm).Rows("1").RowHeight         '行高
Mdyggs(2) = Worksheets(Mgzbm).Columns("A").ColumnWidth     '列宽
'单元格"值"
Mdyggs(3) = Worksheets(Mgzbm).Range("A1")
'单元格格式"数字"
Mdyggs(4) = Worksheets(Mgzbm).Range(Mdygm).NumberFormatLocal
'单元格格式"对齐"
Mdyggs(5) = Worksheets(Mgzbm).Range(Mdygm).HorizontalAlignment   '水平对齐
Mdyggs(6) = Worksheets(Mgzbm).Range(Mdygm).VerticalAlignment     '垂直对齐
Mdyggs(7) = Worksheets(Mgzbm).Range(Mdygm).WrapText              '自动换行
Mdyggs(8) = Worksheets(Mgzbm).Range(Mdygm).Orientation          '文本方向
Mdyggs(9) = Worksheets(Mgzbm).Range(Mdygm).AddIndent             '增加缩进
Mdyggs(10) = Worksheets(Mgzbm).Range(Mdygm).ShrinkToFit           '缩小字体填充
Mdyggs(11) = Worksheets(Mgzbm).Range(Mdygm).MergeCells            '合并单元格
'单元格格式"字体"
Mdyggs(12) = Worksheets(Mgzbm).Range(Mdygm).Font.Name           '字体
Mdyggs(13) = Worksheets(Mgzbm).Range(Mdygm).Font.FontStyle       '字形
Mdyggs(14) = Worksheets(Mgzbm).Range(Mdygm).Font.Size            '字号
Mdyggs(15) = Worksheets(Mgzbm).Range(Mdygm).Font.Strikethrough   '删除线
Mdyggs(16) = Worksheets(Mgzbm).Range(Mdygm).Font.Superscript     '上标
Mdyggs(17) = Worksheets(Mgzbm).Range(Mdygm).Font.Subscript       '下标
Mdyggs(18) = Worksheets(Mgzbm).Range(Mdygm).Font.OutlineFont     '
Mdyggs(19) = Worksheets(Mgzbm).Range(Mdygm).Font.Shadow          '
Mdyggs(20) = Worksheets(Mgzbm).Range(Mdygm).Font.Underline       '下划线
Mdyggs(21) = Worksheets(Mgzbm).Range(Mdygm).Font.ColorIndex      '颜色
'单元格格式"图案"
Mdyggs(22) = Worksheets(Mgzbm).Range(Mdygm).Interior.ColorIndex         '底纹颜色
Mdyggs(23) = Worksheets(Mgzbm).Range(Mdygm).Interior.Pattern            '底纹图案
Mdyggs(24) = Worksheets(Mgzbm).Range(Mdygm).Interior.PatternColorIndex  '底纹图案颜色
'单元格格式"保护"
Mdyggs(25) = Worksheets(Mgzbm).Range(Mdygm).Locked         '锁定
Mdyggs(26) = Worksheets(Mgzbm).Range(Mdygm).FormulaHidden  '隐藏
'单元格格式"边框"
Mdyggs(27) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeTop).ColorIndex           '上 颜色
Mdyggs(28) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeTop).LineStyle            '上 式样
Mdyggs(29) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeTop).Weight               '上 粗细
Mdyggs(30) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeBottom).ColorIndex        '下
Mdyggs(31) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeBottom).LineStyle         '
Mdyggs(32) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeBottom).Weight            '
Mdyggs(33) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeLeft).ColorIndex          '左
Mdyggs(34) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeLeft).LineStyle           '
Mdyggs(35) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeLeft).Weight              '
Mdyggs(36) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeRight).ColorIndex         '右
Mdyggs(37) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeRight).LineStyle          '
Mdyggs(38) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlEdgeRight).Weight             '
Mdyggs(39) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlDiagonalDown).ColorIndex      '左上到右下
Mdyggs(40) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlDiagonalDown).LineStyle       '
Mdyggs(41) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlDiagonalDown).Weight          '
Mdyggs(42) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlDiagonalUp).ColorIndex        '右上到左下
Mdyggs(43) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlDiagonalUp).LineStyle         '
Mdyggs(44) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlDiagonalUp).Weight            '
Mdyggs(45) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlInsideHorizontal).ColorIndex  '区域内横线
Mdyggs(46) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlInsideHorizontal).LineStyle   '
Mdyggs(47) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlInsideHorizontal).Weight      '
Mdyggs(48) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlInsideVertical).ColorIndex    '区域内竖线
Mdyggs(49) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlInsideVertical).LineStyle     '
Mdyggs(50) = Worksheets(Mgzbm).Range(Mdygm).Borders(xlInsideVertical).Weight        '
A = "       “行”行高:       “列”列宽:      单元格“值”:   单元格格式“数字”:" _
& "    “对齐”水平对齐:    “对齐”垂直对齐:    “对齐”自动换行:    “对齐”文本方向:" _
& "    “对齐”增加缩进:  “对齐”缩小字体填充:   “对齐”合并单元格:      “字体”字体:" _
& "      “字体”字形:      “字体”字号:     “字体”删除线:      “字体”上标:" _
& "      “字体”下标:      “字体”未知:      “字体”未知:     “字体”下划线:" _
& "      “字体”颜色:    “图案”底纹颜色:    “图案”底纹图案:  “图案”底纹图案颜色:" _
& "      “保护”锁定:      “保护”隐藏:    “边框”上线颜色:    “边框”上线式样:" _
& "    “边框”上线粗细:    “边框”下线颜色:    “边框”下线式样:    “边框”下线粗细:" _
& "    “边框”左线颜色:    “边框”左线式样:    “边框”左线粗细:    “边框”右线颜色:" _
& "    “边框”右线式样:    “边框”右线粗细:“边框”左上到右下线颜色:“边框”左上到右下线式样:" _
& "“边框”左上到右下线粗细:“边框”右上到左下线颜色:“边框”右上到左下线式样:“边框”右上到左下线粗细:" _
& " “边框”区域内横线颜色: “边框”区域内横线式样: “边框”区域内横线粗细: “边框”区域内竖线颜色:" _
& " “边框”区域内竖线式样: “边框”区域内竖线粗细:     “行”有效行数:     “列”有效列数:"
For i = 1 To 52
If i < 27 Then
B = B & Mid(A, (i - 1) * 13 + 1, 13) & " " & Mdyggs(i) & Chr(13)
Else
C = C & Mid(A, (i - 1) * 13 + 1, 13) & " " & Mdyggs(i) & Chr(13)
End If
Next i
MsgBox B, vbOKOnly, "工作表格式1"
MsgBox C, vbOKOnly, "工作表格式2"
End Sub

版权声明:本文著作权归原作者所有,欢迎分享本文,谢谢支持!
转载请注明:EXCEL VBA:如何获取单元格格式? | 猎微网
分类:Excel VBA 标签:, , ,

评论已关闭!