如何通過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 = "常規(guī)" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With End Sub

=========================================================================================

VB創(chuàng)建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) ''''''區(qū)域 背景色
????????????
??????????? ''''''''''''''''''''''''''''''
??????????? .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 '釋放引用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''寫入數(shù)據(jù)'''''''''''''''''''''''''''''''''''''''''''''
Dim j, LengthTXT, k, Num, NEXCEL As Integer
Dim StrTxt As String
On Error Resume Next
'''''''''''''''''''''''''''計算數(shù)組的圍數(shù) 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)? '重定義圍數(shù)
'''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''賦值給數(shù)組 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
??? '''''''''''''''''''''''''''''''''''數(shù)值分段存儲到數(shù)組,每組為一個實測值
??? Dim TowArray() As String
??? Dim WS, N As Integer
??? WS = Num \ 4 '''''''''''''''''圍數(shù)
??? 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
'??? ''''''''''''''''''''''''''''''''''數(shù)值轉換
??? ''''第4個字節(jié)轉換為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)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''將數(shù)據(jù)寫入到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) '''''設置一個返回函數(shù)
??????? 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 '標志旁附圖例項標志***? 標志數(shù)值
??????? xllBook.Save
??????? xllApp.ActiveWorkbook.Save
??????? xllApp.Application.Quit
??? Set xllApp = Nothing '表忘釋放引用
End Sub

總結

以上是生活随笔為你收集整理的如何通过VB合并Excel单元格以及设置Excel行高？VB创建Excel表格，合并单元格，生成图形等操作的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內容還不錯，歡迎將生活随笔推薦給好友。