由于最近開(kāi)發(fā)軟件的過(guò)程中需要打印VB的代碼，但當(dāng)代碼很多時(shí)感覺(jué)打印出來(lái)的黑黑的滿篇子不如在編輯器里看那彩色的代碼省力，在網(wǎng)上找了半天也沒(méi)找到合適的工具來(lái)解決這個(gè)問(wèn)題，看來(lái)想偷懶是不行了，于是就用Word編了一個(gè)小程序，算法不優(yōu)，速度也不快，不過(guò)總比手動(dòng)強(qiáng)多了0 && image.height>0){if(image.width>=700){this.width=700;this.height=image.height*700/image.width;}}" src="http://blog.hexun.com//CuteSoft_Client/CuteEditor/images/emwink.gif" src_cetemp="http://blog.hexun.com//CuteSoft_Client/CuteEditor/images/emwink.gif" align="absMiddle" border="0">，以后在網(wǎng)上發(fā)代碼也可以是彩色的了，下面就是用這段代碼就是程序格式化后的效果。下載后將兩個(gè)文件導(dǎo)入到Word的VBA中，然后第一次使用前先運(yùn)行宏“ShowFormatSet”做好相關(guān)設(shè)置，再運(yùn)行宏“FormatVBCode”就能將復(fù)制到word中的VB代碼格式化好了。說(shuō)明：最終格式化結(jié)果可能和vb編輯器略有不同。
Dim EditChanged As Boolean, CurrRow As Integer, CurrCol As Integer, EditState As Boolean
Private Sub Command1_Click()
'設(shè)置單元格A1的格式為"K0+000.00"
Sheet("A1").FormatString = "K0+000.00": Call Calculate
End Sub
Private Sub Form_Load()
Dim I As Integer, J As Integer
Me.Caption = "模擬Excel計(jì)算表格"
CreateTableHead 100 '生成表頭
With Text2
.Appearance = 0
.Visible = False: EditChanged = False
.Font.Size = 11
End With
With MSHFlexGrid1
Frame1.Caption = "單元格" & .TextMatrix(0, 1) & .TextMatrix(1, 0) & "的公式"
'初始化表格對(duì)象
For J = 1 To .Rows - 1
For I = 1 To .Cols - 1
'單元格地址用A1形式表示,公式,單元格格式,單元格文本,行,列,索引關(guān)鍵字
Sheet.Add .TextMatrix(0, I) & J, "", "", "", J, I, .TextMatrix(0, I) & J
Next
Next
End With
End Sub
Private Sub CreateTableHead(R As Integer)
With MSHFlexGrid1
.Cols = 20
.Rows = 20
.Font.Size = 12
.AllowUserResizing = flexResizeBoth
s$ = " |"
For J = 65 To 90
s$ = s$ & Chr(J) & "|"
Next
s$ = Left(s$, Len(s$) - 1)
s$ = s$ & ";|"
For J = 1 To R
s$ = s$ & J & "|"
Next
.FormatString = Left(s$, Len(s$) - 1)
For J = 1 To 26
.ColWidth(J) = 1000
Next
End With
End Sub
Private Sub Label1_Click()
'打開(kāi)某個(gè)網(wǎng)址
'ShellExecute Me.hwnd, "open", "http://dongxingsofthome.blog.hexun.com/", vbNullString, vbNullString, vbNormalFocus
Shell "C:\\Program Files\\Internet Explorer\\IEXPLORE.EXE http://dongxingsofthome.blog.hexun.com/8341928_d.html", vbMaximizedFocus
'給某個(gè)信箱發(fā)電子郵件
'ShellExecute hWnd, "open", "mailto:sst95@21cn.com", vbNullString, vbNullString, 0
End Sub
Private Sub MSHFlexGrid1_DblClick()
If MSHFlexGrid1.Text <> "" Then
EditState = True
Else
EditState = False
End If
With MSHFlexGrid1
Text2.Text = Sheet(.TextMatrix(0, .Col) & .Row).Formula
End With
Text2.Visible = True
With MSHFlexGrid1
Text2.Top = .CellTop + 2010
Text2.Left = .CellLeft + 90
Text2.Height = .CellHeight - 20
Text2.Width = .CellWidth + 30
Text2.SetFocus
End With
End Sub
Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 229 Then
Text2.Text = ""
ElseIf KeyCode <> 37 And KeyCode <> 38 And KeyCode <> 39 And KeyCode <> 40 Then
Text2.Text = ""
End If
If KeyCode = 46 Then '處理Delete鍵
Text1.Text = ""
With MSHFlexGrid1
For J = .Row To .RowSel
For I = .Col To .ColSel
.TextMatrix(J, I) = ""
Sheet.Item(.TextMatrix(0, I) & J).Formula = ""
Next
Next
End With
End If
End Sub
Private Sub MSHFlexGrid1_KeyPress(KeyAscii As Integer)
If KeyAscii < 255 And KeyAscii <> 27 And KeyAscii <> 8 Then
If Chr(KeyAscii) = "=" Then
Text2.Text = ""
End If
Text2.Text = Text2.Text & Chr(KeyAscii)
End If
If KeyAscii = 8 Then 'back
Text2.Text = ""
End If
If KeyAscii <> 27 And KeyAscii <> 13 Then
Text2.SelStart = Len(Text2.Text)
Text2.Visible = True
With MSHFlexGrid1
Text2.Top = .CellTop + 2010
Text2.Left = .CellLeft + 90
Text2.Height = .CellHeight - 20
Text2.Width = .CellWidth + 30
Text2.SetFocus
End With
End If
If KeyAscii = 13 Then
MSHFlexGrid1.Row = MSHFlexGrid1.Row + 1: EditChanged = False
With MSHFlexGrid1
Frame1.Caption = "單元格" & .TextMatrix(0, .Col) & .TextMatrix(.Row, 0) & "的公式"
Text1.Text = Sheet.Item(MSHFlexGrid1.TextMatrix(0, MSHFlexGrid1.Col) & MSHFlexGrid1.Row).Formula
End With
End If
End Sub
Private Sub MSHFlexGrid1_RowColChange()
If EditChanged = True Then
With MSHFlexGrid1
.TextMatrix(CurrRow, CurrCol) = Text2.Text
Sheet.Item(.TextMatrix(0, CurrCol) & CurrRow).Formula = Text2.Text
End With
Call Calculate
End If
Text2.Visible = False: EditChanged = False
Text1.Text = Sheet.Item(MSHFlexGrid1.TextMatrix(0, MSHFlexGrid1.Col) & MSHFlexGrid1.Row).Formula
End Sub
Private Sub MSHFlexGrid1_SelChange()
With MSHFlexGrid1
Frame1.Caption = "單元格" & .TextMatrix(0, .Col) & .TextMatrix(.Row, 0) & "的公式"
'在公式欄內(nèi)顯示單元格的公式
Text1.Text = Sheet.Item(MSHFlexGrid1.TextMatrix(0, MSHFlexGrid1.Col) & MSHFlexGrid1.Row).Formula
End With
End Sub
Private Sub Text2_Change()
EditChanged = True
CurrRow = MSHFlexGrid1.Row
CurrCol = MSHFlexGrid1.Col
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode '處理光標(biāo)鍵
Case 37, 38, 39, 40
If EditState = False Then
Call SetCellContent(Text2.Text)
Text2.Visible = False
If KeyCode = 40 Then
MSHFlexGrid1.Row = MSHFlexGrid1.Row + 1
ElseIf KeyCode = 37 Then
MSHFlexGrid1.Col = MSHFlexGrid1.Col - 1
ElseIf KeyCode = 39 Then
MSHFlexGrid1.Col = MSHFlexGrid1.Col + 1
ElseIf KeyCode = 38 Then
MSHFlexGrid1.Row = MSHFlexGrid1.Row - 1
End If
End If
EditState = False
MSHFlexGrid1.SetFocus
End Select
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13 '處理回車(chē)鍵Enter
Call SetCellContent(Text2.Text)
Text2.Visible = False
MSHFlexGrid1.Row = MSHFlexGrid1.Row + 1
MSHFlexGrid1.SetFocus
EditState = False
EditChanged = False
MSHFlexGrid1.SetFocus
Case 27 '處理ESC鍵
Text2.Visible = False
MSHFlexGrid1.SetFocus
EditChanged = False
End Select
End Sub
聯(lián)系客服
