Dim VbExcell As Object
Dim vbbook As Object
Dim Fname$, AppDisk$, Trows&, Tcols&, aa$, bb$, i&, j&, k&
Private Sub Form_Load()
AppDisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
Fname = AppDisk & "aaa.xls"
Set VbExcell = CreateObject("Excel.Application") '创建excel对象
VbExcell.Visible = True '对象可见
Set vbbook = VbExcell.Workbooks.Open(Fname) '打开文件
If Val(VbExcell.Application.Version) >= 8 Then
Set vbbook = VbExcell.ActiveSheet
Else
Set vbbook = VbExcell
End If
End Sub
Private Sub Command1_Click()
Trows = VbExcell.ActiveSheet.UsedRange.Rows.Count
Tcols = VbExcell.ActiveSheet.UsedRange.Columns.Count
For i = 1 To Trows
For j = 1 To Tcols
aa = VbExcell.Cells(i, j).Text
If ChkChinese(aa) Then
VbExcell.Cells(i, j).Font.Name = "楷体"
Else
VbExcell.Cells(i, j).Font.Name = "Verdana"
End If
Next
Next i
End Sub
Function ChkChinese(TmpStr$) As Boolean
ChkChinese = False
For k = 1 To Len(TmpStr)
bb = UCase(Mid(TmpStr, k, 1))
If bb = "." Or (Asc(bb) >= 48 And Asc(bb) <= 57) Or (Asc(bb) >= 65 And Asc(bb) <= 90) Then
Else
ChkChinese = True: Exit For
End If
Next k
End Function