vb 操作excel单元格斜线上标下标问题
怎么用VB在一个单元格上画一条斜线，然后再斜线的上边和下边写入数值？请大侠们帮帮忙！！
[解决办法]
Sub Macro1() Selection.NumberFormatLocal = "@" ActiveCell.FormulaR1C1 = "2/3" With ActiveCell.Characters(Start:=1, Length:=1).Font .Name = "宋体" .FontStyle = "常规" .Size = 12 .Strikethrough = False .Superscript = True .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With With ActiveCell.Characters(Start:=2, Length:=1).Font .Name = "宋体" .FontStyle = "常规" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With With ActiveCell.Characters(Start:=3, Length:=1).Font .Name = "宋体" .FontStyle = "常规" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = True .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B1").SelectEnd Sub
[解决办法]
窗体代码
Private Sub Command1_Click() Dim bolP As Boolean bolP = funOpenExcelFile(xlsApp, xlsBook, xlsSheet, App.Path & "\111.xls", "Sheet1", "", True)End SubPrivate Sub Command2_Click() With xlsApp.Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With xlsApp.Selection.Borders(xlDiagonalDown) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With xlsApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone xlsApp.Selection.Borders(xlEdgeLeft).LineStyle = xlNone xlsApp.Selection.Borders(xlEdgeTop).LineStyle = xlNone xlsApp.Selection.Borders(xlEdgeBottom).LineStyle = xlNone xlsApp.Selection.Borders(xlEdgeRight).LineStyle = xlNone xlsApp.Range("A1").Select xlsApp.ActiveCell.FormulaR1C1 = "1 1" With xlsApp.ActiveCell.Characters(Start:=1, Length:=8).Font .Name = "宋体" .FontStyle = "常规" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With xlsApp.Range("J22").Select xlsApp.ActiveCell.FormulaR1C1 = "1 1" With xlsApp.ActiveCell.Characters(Start:=1, Length:=8).Font .Name = "宋体" .FontStyle = "常规" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With' xlsApp.Range("L23").SelectEnd SubPrivate Sub Command4_Click() Dim bolP As Boolean bolP = funCloseExcelFile(xlsApp, xlsBook, xlsSheet, True)End Sub
[解决办法]
标准模块代码
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％'模块功能：'设计单位：'设 计 者：'设计时间：'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％Option ExplicitPublic xlsApp As Excel.Application 'Excel应用对象Public xlsBook As Excel.Workbook 'Excel工作薄对象Public xlsSheet As Excel.Worksheet 'Excel工作表对象'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％'函数功能：打开指定的Excel文件'参数说明：xlsAPP：Excel应用对象' ：xlsWork：Excel工作薄对象' ：xlsSheet：Excel工作表对象' ：strExcelFile：Excel文件路径' ：strSheetName：工作表名' ：strPWD：密码' ：bolVisible：表的可见性'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％Public Function funOpenExcelFile(ByRef xlsApp As Excel.Application, _ ByRef xlsWork As Excel.Workbook, _ ByRef xlsSheet As Excel.Worksheet, _ ByVal strExcelFile As String, _ ByVal strSheetName As String, _ ByVal strPWD As String, _ ByVal bolVisible As Boolean) As BooleanOn Error GoTo errFun funOpenExcelFile = False Set xlsApp = CreateObject("Excel.Application") Set xlsWork = xlsApp.Workbooks.Open(strExcelFile, , False, , strPWD, strPWD) Set xlsSheet = xlsBook.Worksheets(strSheetName) xlsSheet.Activate xlsApp.Visible = bolVisible funOpenExcelFile = True Exit FunctionerrFun: funOpenExcelFile = FalseEnd Function'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％'函数功能：关闭指定的Excel文件'参数说明：xlsAPP：Excel应用对象' ：xlsWork：Excel工作薄对象' ：xlsSheet：Excel工作表对象' ：bolSave：是否保存'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％Public Function funCloseExcelFile(ByRef xlsApp As Excel.Application, _ ByRef xlsWork As Excel.Workbook, _ ByRef xlsSheet As Excel.Worksheet, _ ByVal bolSave As Boolean) As BooleanOn Error GoTo errFun If bolSave Then xlsBook.Save Set xlsSheet = Nothing xlsBook.Close Set xlsBook = Nothing Set xlsApp = Nothing funCloseExcelFile = True Exit FunctionerrFun: funCloseExcelFile = FalseEnd Function'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％'函数功能：读取指定单元格的内容'参数说明：xlsSheet：工作表对象' ：lngRow：行号' ：lngCol：列号'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％Public Function funReadCellText(ByRef xlsSheet As Excel.Worksheet, _ ByVal lngRow As Long, _ ByVal lngCol As Long) As String On Error GoTo errFun funReadCellText = "" If lngRow <= 0 Or lngCol <= 0 Then Exit Function funReadCellText = xlsSheet.Cells(lngRow, lngCol) Exit FunctionerrFun: funReadCellText = ""End Function'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％'函数功能：设置指定单元格的内容'参数说明：xlsSheet：工作表对象' ：lngRow：行号' ：lngCol：列号'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％Public Function funSetCellText(ByRef xlsSheet As Excel.Worksheet, _ ByVal lngRow As Long, _ ByVal lngCol As Long, _ ByVal strSetCellText As String) As Boolean On Error GoTo errFun funSetCellText = False If lngRow <= 0 Or lngCol <= 0 Then Exit Function xlsSheet.Cells(lngRow, lngCol) = strSetCellText funSetCellText = True Exit FunctionerrFun: funSetCellText = ""End Function
[解决办法]
不能同时在一个单元格中同时设上标和下标，不过只要将水平对齐设为分散居中就可以达到目的了。
xlsApp.ActiveCell.FormulaR1C1 = "A B"xlsApp.ActiveCell.HorizontalAlignment = xlDistributed