如何通过VB合并Excel单元格以及设置Excel行高?VB创建Excel表格,合并单元格,生成图形等操作
如何通过VB合并Excel单元格以及设置Excel行高?
例如:我想把第一列的第4,5,6,7行合并。。。我在怎样让合并单元格里的字居中,怎样改变字体。 请不吝赐教。。。
==========================================================
首先在VB中引用microsoft excel object library假设c盘根目录下有个1.xls的文件 …………问题补充:你的要求很简单,一行指令恐怕不行,最少要三行代码如下:Private Sub Form_Load()Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetDim i As IntegerSet xlApp = CreateObject("Excel.Application")Set xlBook = xlApp.Workbooks.Open("C:\1.xls")Set xlSheet = xlBook.Worksheets(1) '引用第1张工作表For i = 3 To 100 Step 3 '想到哪行就把100改成几xlSheet.Range(Cells(i, 1), Cells(i, 2)).Merge '合并a1:b2单元格NextxlSheet.Rows(10).RowHeight = 100 '把第10行高度设为100xlBook.SavexlApp.Application.QuitSet xlApp = Nothing '表忘释放引用End Sub运行一下,看看满足要求否。
===========================================================================================
Sub Macro1()Range("A4:A7").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection.Font .Name = "隶书" .FontStyle = "常规" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With End Sub
=========================================================================================
VB创建Excel表格,合并单元格,生成图形等操作
Private Sub Command4_Click()
On Error Resume Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''Create Excel Table''''''''''''''''''''''''''''''''''''''''''
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlSheet1 As Excel.Worksheet
Dim i As Integer, tmHour As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set xlApp = Excel.Application
Set xlBook = xlApp.Workbooks.Add
'xlBook.Activate
Set xlSheet = xlBook.Worksheets(1) '''''''''''''''''''''''''''''''''引用第1张工作表
xlApp.ActiveSheet.Rows.VerticalAlignment = xlVAlignCenter '''''垂直方向居中
xlApp.ActiveSheet.Rows.HorizontalAlignment = xlVAlignCenter '''水平方向居中
xlSheet.Name = "实测值"
Set xlSheet1 = xlBook.Worksheets(2)
xlSheet1.Name = "Chart"
With xlSheet
For i = 2 To 11
.Range(Cells(1, 1), Cells(1, i)).Merge ''''''''''''''''''''合并A-K单元格
Next
' .Cells(1, 1).ForeColor = RGB(100, 150, 255)
.Cells(1, 1).Font.Size = 25
''''''''''''''''''''''''''设置行高'设置列宽
For i = 1 To 22
.Rows(i).RowHeight = 25
Next
For i = 1 To 11
.Columns(i).ColumnWidth = 15
Next
'''''''''''''''''''''''''''合并单元格
For i = 3 To 22
If i < 8 Then
.Range(Cells(3, 1), Cells(i, 1)).Merge '''''''''''合并A3-A7单元格
.Range(Cells(3, 8), Cells(i, 8)).Merge '''''''''''合并H3-H7单元格
ElseIf i < 13 Then
.Range(Cells(8, 1), Cells(i, 1)).Merge
.Range(Cells(8, 8), Cells(i, 8)).Merge
ElseIf i < 18 Then
.Range(Cells(13, 1), Cells(i, 1)).Merge
.Range(Cells(13, 8), Cells(i, 8)).Merge
ElseIf i < 23 Then
.Range(Cells(18, 1), Cells(i, 1)).Merge
.Range(Cells(18, 8), Cells(i, 8)).Merge
End If
Next
''''''''''''''''''''''''''''''''''''''''''''
.Range("A1", "K22").Borders.LineStyle = xlContinuous '''''''单元格边框
.Range("A1", "K22").Borders.Color = vbBlue '''''''''''''''''边框颜色
.Range("A1", "K22").Interior.Color = RGB(100, 180, 0) ''''''区域 背景色
''''''''''''''''''''''''''''''
.Range("A1").Value = "iWatt 项目"
.Range("A1").Font.Color = vbRed ''''''''''''''设置字体颜色
.Range("A1").Font.Name = "楷书" ''''''''''''''设置字体字型
.Range("A1").Font.Size = 30 ''''''''''''''''''设置字体字号
'''''''''''''''''''''''''''''''''''''''
.Range("A2").Value = "输入电压(VAC)"
.Range("B2").Value = "输入功率(W)"
.Range("C2").Value = "输出电压(V)"
.Range("D2").Value = "输出电流mA)"
.Range("E2").Value = "输出功率(W)"
.Range("F2").Value = "纹波电压(A)"
.Range("G2").Value = "效率(%)"
.Range("H2").Value = "过流点(A)"
.Range("I2").Value = "初级到次级功率损耗(W)"
.Range("J2").Value = "平均功率%"
.Range("K2").Value = "需符合CEC标准"
'''''''''''''''''''''''''''''''''''电压值
.Range("A3").Value = "90"
.Range("A8").Value = "115"
.Range("A13").Value = "230"
.Range("A18").Value = "264"
'''''''''''''''''''''''''''''''''''负载值
.Range("D3").Value = "0"
.Range("D4").Value = "1/4 Load"
.Range("D5").Value = "2/4 Load"
.Range("D6").Value = "3/4 Load"
.Range("D7").Value = "Full Load"
.Range("D8").Value = "0"
.Range("D9").Value = "1/4 Load"
.Range("D10").Value = "2/4 Load"
.Range("D11").Value = "3/4 Load"
.Range("D12").Value = "Full Load"
.Range("D13").Value = "0"
.Range("D14").Value = "1/4 Load"
.Range("D15").Value = "2/4 Load"
.Range("D16").Value = "3/4 Load"
.Range("D17").Value = "Full Load"
.Range("D18").Value = "0"
.Range("D19").Value = "1/4 Load"
.Range("D20").Value = "2/4 Load"
.Range("D21").Value = "3/4 Load"
.Range("D22").Value = "Full Load"
End With
tmHour = "-" & Hour(Time)
tmHour = tmHour & "-" & Minute(Time)
tmHour = tmHour & "-" & Second(Time)
xlApp.ActiveWorkbook.SaveAs App.Path & "\" & Format(Date, dddd, mmmm, yyyy) & tmHour + ".xls"
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing '释放引用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''写入数据'''''''''''''''''''''''''''''''''''''''''''''
Dim j, LengthTXT, k, Num, NEXCEL As Integer
Dim StrTxt As String
On Error Resume Next
'''''''''''''''''''''''''''计算数组的围数 NUM
LengthTXT = Len(Text1.Text)
StrTxt = Text1.Text
Num = 1
For i = 1 To LengthTXT
If Mid(Text1.Text, i, 1) = "," Then
Num = Num + 1
End If
Next
ReDim StrDataArray(Num) '重定义围数
'''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''赋值给数组 StrDataArray
If Num = 1 Then
StrDataArray(Num) = StrTxt
Else
For i = 1 To LengthTXT
StrData = StrData & Mid(StrTxt, i, 1)
k = k + 1
If Mid(StrTxt, i, 1) = "," Then
j = j + 1
StrDataArray(j) = Left(StrData, k - 1)
StrData = ""
k = 0
End If
StrDataArray(Num) = StrData
Next
End If
' '''''''''''''''''''''''''''''check StrDataArray(i)
' For i = 1 To Num
' MsgBox StrDataArray(i) & " " & i
' Next
'''''''''''''''''''''''''''''''''''数值分段存储到数组,每组为一个实测值
Dim TowArray() As String
Dim WS, N As Integer
WS = Num \ 4 '''''''''''''''''围数
ReDim TowArray(WS, 4)
For i = 1 To Num - 2
N = i \ 4
For j = 1 To 4
'If i \ 4 = 0 Then
TowArray(N + 1, j) = StrDataArray(j + 4 * N)
' End If
Next
Next
' ''''''''''''''''''''''''''''''''check TowArray(N + 1, j)
' For i = 1 To WS
' MsgBox TowArray(i, 1) & TowArray(i, 2) & TowArray(i, 3) & TowArray(i, 4)
' Next
' ''''''''''''''''''''''''''''''''''数值转换
''''第4个字节转换为2进制
ReDim ByteDataString(WS)
For i = 1 To Num \ 4
'MsgBox TowArray(i, 4) MsgBox CStr(TowArray(i, 4))
ByteDataString(i) = HexToByte(CStr(TowArray(i, 4))) '''''转换为2进制,8位
'MsgBox ByteDataString(i) & " " & i
Next
'''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''打开Excel 文件!
Dim filename As String
With CommonDialog1
.DialogTitle = "打开Excel文件"
.Filter = "(Excel)*.xls| *.xls"
.ShowOpen
filename = .filename
' MsgBox filename
End With
'''''''''''''''''''''''''
Dim xllApp As Excel.Application
Dim xllBook As Excel.Workbook
Dim xllSheet As Excel.Worksheet
Dim xllSheet1 As Excel.Worksheet
Dim StrRow As String
'Dim i As Integer
Set xllApp = CreateObject("Excel.Application")
Set xllBook = xllApp.Workbooks.Open(filename)
Set xllSheet = xllBook.Worksheets(1) '引用第1张工作表
Set xllSheet1 = xllBook.Worksheets(2)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''将数据写入到Excel单元格中
With xllSheet
For i = 1 To WS
NEXCEL = i
StrRow = "B" & CStr(i + 2)
' MsgBox ByteDataString(i) '& StrRow
.Range(StrRow).Value = ValueOfData(ByteDataString(i), NEXCEL) '''''设置一个返回函数
Next
End With
Set ct = xllApp.Worksheets("Chart").ChartObjects.Add(100, 40, 300, 350) '插入图形''位置(10,40)为图形位置,(220,120)为图形的大小
ct.Chart.ChartType = xlLineStacked 'xlColumnClustered '块状图 'xl3DColumnStacked '立體直條圖'xl3DPie '图形类型为饼图
ct.Chart.SetSourceData Source:=Sheets("实测值").Range("B3:B6"), PlotBy:=xlColumns
With ct.Chart
.HasTitle = True
.ChartTitle.Characters.Font.Size = 20
.ChartTitle.Characters.Text = "折线图" '图表标题为饼图
.ChartTitle.Shadow = True ''''''标题添加边框
End With
ct.Chart.ApplyDataLabels 2, True '标志旁附图例项标志*** 标志数值
xllBook.Save
xllApp.ActiveWorkbook.Save
xllApp.Application.Quit
Set xllApp = Nothing '表忘释放引用
End Sub
如何通过VB合并Excel单元格以及设置Excel行高?VB创建Excel表格,合并单元格,生成图形等操作相关推荐
- PHP excel导出(自定义样式,行高,合并单元格等)
PHP 导出多个sheet 或者导出带样式的excel 修改样式方式见下文 具体使用需要根据具体业务进行一些调整和封装 $PHPExcel = new \PHPExcel(); $sheetIndex ...
- excel设置单元格边框线, 自适应行高
/*** 设置单元格边框线, 自适应行高** @param workbook*/private static void setBorderAndLineHeight(Workbook workbook ...
- 使用POI创建word表格合并单元格兼容wps
poi创建word表格合并单元格代码如下: /** * @Description: 跨列合并 */ public void mergeCellsHorizontal(XWPFTable table, ...
- POI excel 单元个的内容 自适应行高
POI excel 单元个的内容 自适应行高 public static void main(String[] args) {InputStream is = null;Workbook book = ...
- POI java导出Excel设置自适应行高
本文章参考于:https://www.cnblogs.com/dtts/p/4741575.html 需求:根据单元格的内容自动设置行高 代码: /*** 设置自适应行高的方法*/public int ...
- Microsoft Excel 教程:如何在 Excel 中更改列宽或行高?
欢迎观看 Microsoft Excel 教程,小编带大家学习 Microsoft Excel 的使用技巧,了解如何在 Excel 中更改列宽或行高. 可以手动调整列宽或行高,或者自动调整列和行的大小 ...
- vsflexgrid单元格换行后自动使用行高_「Excel技巧」Excel关于换行的技巧,你懂多少?...
今天话题,主要分享Excel换行的技巧.Excel单元格内换行,有自动换行和强制换行,批量强制换行.现在就来看看它们的区别及设置方式. 一.自动换行 自动换行的长度是根据单元格的列宽来定的,即单元格第 ...
- HTML表格(合并单元格、边框、行高、间距等样式)
HTML实现表格的核心是table(表格).tr(行).td(单元格). 基础结构 <table><tr><td></td><td>< ...
- 如何快速选中某单元格所在的整行或整列 Excel教程
我们可以使用快捷键的操作来快速选中B3单元格所在的整行或整列,操作方法如下,请大家参阅! 一.正规的快捷键操作 ①快速选中整行 按下键盘上的 Shift Space 即同时按下键盘上的Shift 空格 ...
最新文章
- 洛谷P1016 旅行家的预算 贪心
- 8、mybatis之增删改查
- MATLAB2017 on winserver2012 第48周运行日志
- 8086实时时钟实验(一)——《x86汇编语言:从实模式到保护模式》05
- LAMP+LNMP(四)PHP安装实践
- 名词解释(容器、并发,插件,脚本)及程序对象的创建和注释文档
- .Net Core 之 Ubuntu 14.04 部署过程
- 【排序算法】计数排序
- 【CodeForces - 244A 】Dividing Orange (构造,水题)
- 庆祝自开博来首篇浏览数过万的随笔诞生 - [原创]从程序员角度分析安徽电信HTTP劫持的无耻行径......
- 基于原生javascript的淡入淡出函数封装(兼容IE)
- hosts文件在哪里,怎样配置修改hosts文件
- chorme浏览器完美保存整个网页
- PL0编译器分析与语法扩展
- 瑞吉外卖项目学习笔记01
- java查找文件路径_如何查找java路径?
- 人喜欢音乐的部分原因:形成期望,不确定性
- c语言中字符表,C语言指令表与符号表
- 通过机器学习的线性回归算法预测股票走势(用Python实现)
- Ubuntu/macos下安装stlink-v2驱动
热门文章
- android 拍摄视频后返回九宫格,抖音九宫格不同视频怎么拍 九个不同的视频在一个画面播放...
- 英语口语练习三十之听歌学口语:Boom Clap,你在我的世界里闪闪发光用法
- #Paper Reading# Why Should I Trust You? Explaining the Predictions of Any Classifier
- 简单胜过复杂的汽车人机界面HMI
- 天猫618红包口令怎么获取?天猫618红包使用条件有哪些?
- 【翻译论文】 Supervised Parametric Classification of Aerial LiDAR Data(2004)
- php 查询mysql数据库 打印_php 查询mysql数据库 打印
- stm32wb55 基于rtt的ble sample制作过程
- 谷粒学院笔记-第二天-数据库设计
- 轻量迅捷时代,Vite 与Webpack 谁赢谁输