📄 单元格设置.frm
字号:
FontColor(2, 1) = 0
FontColor(2, 2) = 0
FontColor(2, 3) = 255
FontColor(3, 1) = 0
FontColor(3, 2) = 255
FontColor(3, 3) = 255
FontColor(4, 1) = 0
FontColor(4, 2) = 255
FontColor(4, 3) = 0
FontColor(5, 1) = 255
FontColor(5, 2) = 0
FontColor(5, 3) = 255
FontColor(6, 1) = 255
FontColor(6, 2) = 0
FontColor(6, 3) = 0
FontColor(7, 1) = 255
FontColor(7, 2) = 255
FontColor(7, 3) = 0
FontColor(8, 1) = 255
FontColor(8, 2) = 255
FontColor(8, 3) = 255
FontColor(9, 1) = 0
FontColor(9, 2) = 0
FontColor(9, 3) = 128
FontColor(10, 1) = 0
FontColor(10, 2) = 128
FontColor(10, 3) = 128
FontColor(11, 1) = 0
FontColor(11, 2) = 128
FontColor(11, 3) = 0
FontColor(12, 1) = 128
FontColor(12, 2) = 0
FontColor(12, 3) = 128
FontColor(13, 1) = 128
FontColor(13, 2) = 0
FontColor(13, 3) = 0
FontColor(14, 1) = 128
FontColor(14, 2) = 128
FontColor(14, 3) = 0
FontColor(15, 1) = 128
FontColor(15, 2) = 128
FontColor(15, 3) = 128
FontColor(16, 1) = 192
FontColor(16, 2) = 192
FontColor(16, 3) = 192
If imgcboFontColor.SelectedItem.Index <> 0 Then
Me.lblPreview.ForeColor = RGB(FontColor(imgcboFontColor.SelectedItem.Index, 1), FontColor(imgcboFontColor.SelectedItem.Index, 2), FontColor(imgcboFontColor.SelectedItem.Index, 3))
End If
End Sub
Private Sub cboFontName_Click()
Me.lblPreview.FontName = Me.cboFontName.Text
End Sub
Private Sub cboFontSize_Click()
Me.lblPreview.FontSize = Me.cboFontSize.Text
End Sub
Private Sub cboFontStyle_Click()
If Me.cboFontStyle.Text = "常规" Then
Me.lblPreview.FontBold = False
Me.lblPreview.FontItalic = False
ElseIf Me.cboFontStyle.Text = "加粗" Then
Me.lblPreview.FontBold = True
Me.lblPreview.FontItalic = False
ElseIf Me.cboFontStyle.Text = "倾斜" Then
Me.lblPreview.FontBold = False
Me.lblPreview.FontItalic = True
ElseIf Me.cboFontStyle.Text = "加粗 倾斜" Then
Me.lblPreview.FontBold = True
Me.lblPreview.FontItalic = True
End If
End Sub
Private Sub chkFontStrikethru_Click()
Me.lblPreview.FontStrikethru = CBool(Me.chkFontStrikethru.Value)
End Sub
Private Sub chkFontUnderline_Click()
Me.lblPreview.FontUnderline = CBool(Me.chkFontUnderline.Value)
End Sub
Private Sub cmdApply_Click()
Dim CellFormat As F1CellFormat
Dim FontColor(16, 3) As Byte
FontColor(1, 1) = 0
FontColor(1, 2) = 0
FontColor(1, 3) = 0
FontColor(2, 1) = 0
FontColor(2, 2) = 0
FontColor(2, 3) = 255
FontColor(3, 1) = 0
FontColor(3, 2) = 255
FontColor(3, 3) = 255
FontColor(4, 1) = 0
FontColor(4, 2) = 255
FontColor(4, 3) = 0
FontColor(5, 1) = 255
FontColor(5, 2) = 0
FontColor(5, 3) = 255
FontColor(6, 1) = 255
FontColor(6, 2) = 0
FontColor(6, 3) = 0
FontColor(7, 1) = 255
FontColor(7, 2) = 255
FontColor(7, 3) = 0
FontColor(8, 1) = 255
FontColor(8, 2) = 255
FontColor(8, 3) = 255
FontColor(9, 1) = 0
FontColor(9, 2) = 0
FontColor(9, 3) = 128
FontColor(10, 1) = 0
FontColor(10, 2) = 128
FontColor(10, 3) = 128
FontColor(11, 1) = 0
FontColor(11, 2) = 128
FontColor(11, 3) = 0
FontColor(12, 1) = 128
FontColor(12, 2) = 0
FontColor(12, 3) = 128
FontColor(13, 1) = 128
FontColor(13, 2) = 0
FontColor(13, 3) = 0
FontColor(14, 1) = 128
FontColor(14, 2) = 128
FontColor(14, 3) = 0
FontColor(15, 1) = 128
FontColor(15, 2) = 128
FontColor(15, 3) = 128
FontColor(16, 1) = 192
FontColor(16, 2) = 192
FontColor(16, 3) = 192
'对齐
frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
CellFormat.AlignHorizontal = cboHAlign.ListIndex + 1
CellFormat.AlignVertical = cboVAlign.ListIndex + 1
Dim i As Long, j As Long, flag As Integer
flag = 0
For i = frmVchDefine.lDownRow To frmVchDefine.lUpRow
For j = frmVchDefine.lDownCol To frmVchDefine.lUpCol
If Not frmVchDefine.FieldObjectRC(i, j, j) Is Nothing Then
flag = flag + 1
Exit For
End If
Next
Next
If flag < 2 Then
If chkMergeCell.Enabled = True Then
If chkMergeCell.Value = 1 Then
CellFormat.MergeCells = True
ElseIf chkMergeCell.Value = 0 Then
CellFormat.MergeCells = False
End If
End If
End If
If chkWrapText.Value = 1 Then
CellFormat.WordWrap = True
ElseIf chkWrapText.Value = 0 Then
CellFormat.WordWrap = False
End If
frmVchDefine.objF1Book.SetCellFormat CellFormat
'字体
If cboFontName.ListIndex >= 0 And cboFontStyle.ListIndex >= 0 And IsNumeric(cboFontSize.Text) And cboFontSize.Text >= 8 And cboFontSize.Text <= 2160 Then
frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
'CellFormat.FontCharSet
CellFormat.FontName = cboFontName.Text
If cboFontStyle.ListIndex = 0 Then
CellFormat.FontBold = False
CellFormat.FontItalic = False
ElseIf cboFontStyle.ListIndex = 1 Then
CellFormat.FontBold = True
CellFormat.FontItalic = False
ElseIf cboFontStyle.ListIndex = 2 Then
CellFormat.FontBold = False
CellFormat.FontItalic = True
ElseIf cboFontStyle.ListIndex = 3 Then
CellFormat.FontBold = True
CellFormat.FontItalic = True
End If
If IsNumeric(cboFontSize.Text) Then CellFormat.FontSize = cboFontSize.Text
If imgcboFontColor.SelectedItem.Index <> 0 Then
CellFormat.FontColor = RGB(FontColor(imgcboFontColor.SelectedItem.Index, 1), FontColor(imgcboFontColor.SelectedItem.Index, 2), FontColor(imgcboFontColor.SelectedItem.Index, 3))
End If
If chkFontStrikethru.Value = 1 Then
CellFormat.FontStrikeout = True
Else
CellFormat.FontStrikeout = False
End If
If chkFontUnderline.Value = 1 Then
CellFormat.FontUnderline = True
Else
CellFormat.FontUnderline = False
End If
frmVchDefine.objF1Book.SetCellFormat CellFormat
End If
'边框
If LineIndex >= 0 Then
'CellFormat.IsBorderDefined
frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
CellFormat.BorderColor(F1TopBorder) = &H0 ' &HFF&
CellFormat.BorderColor(F1VInsideBorder) = &H0
CellFormat.BorderColor(F1BottomBorder) = &H0
CellFormat.BorderColor(F1LeftBorder) = &H0
CellFormat.BorderColor(F1HInsideBorder) = &H0
CellFormat.BorderColor(F1RightBorder) = &H0
If tlbBorder(0).Buttons(1).Value = tbrPressed Then CellFormat.BorderStyle(F1LeftBorder) = LineIndex
If tlbBorder(1).Buttons(1).Value = tbrPressed Then CellFormat.BorderStyle(F1HInsideBorder) = LineIndex
If tlbBorder(2).Buttons(1).Value = tbrPressed Then CellFormat.BorderStyle(F1RightBorder) = LineIndex
If tlbBorder(3).Buttons(1).Value = tbrPressed Then CellFormat.BorderStyle(F1TopBorder) = LineIndex
If tlbBorder(4).Buttons(1).Value = tbrPressed Then CellFormat.BorderStyle(F1VInsideBorder) = LineIndex
If tlbBorder(5).Buttons(1).Value = tbrPressed Then CellFormat.BorderStyle(F1BottomBorder) = LineIndex
frmVchDefine.objF1Book.SetCellFormat CellFormat
End If
'图案
If PatternIndex <> 0 Then
frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
If PatternIndex = 1 Then
'CellFormat.PatternBG = &H0
'CellFormat.PatternFG = &HFFFFFF
CellFormat.PatternBG = &HFFFFFF
CellFormat.PatternFG = &H0
ElseIf PatternIndex <= 18 Then
CellFormat.PatternBG = &HFFFFFF
CellFormat.PatternFG = &H0
ElseIf PatternIndex = 19 Then
PatternIndex = 0
End If
CellFormat.PatternStyle = Pattern(PatternIndex)
frmVchDefine.objF1Book.SetCellFormat CellFormat
End If
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
cmdApply_Click
Unload Me
End Sub
Private Sub Combo1_DblClick()
frmColor.Left = Combo1.Left
frmColor.Top = Combo1.Top + Combo1.Height
frmColor.Show vbModal
End Sub
Private Sub Form_Load()
Dim i_fra As Integer
Dim sf As New StdFont
For i_fra = 0 To Me.fraCell.Count - 1
Me.fraCell(i_fra).Caption = ""
Me.fraCell(i_fra).BorderStyle = 0
Me.fraCell(i_fra).Left = Me.tabCellFormat.ClientLeft
Me.fraCell(i_fra).Top = Me.tabCellFormat.ClientTop
Me.fraCell(i_fra).Width = Me.tabCellFormat.ClientWidth
Me.fraCell(i_fra).Height = Me.tabCellFormat.ClientHeight
Next
Me.fraCell(0).ZOrder
For i_fra = 0 To Screen.FontCount - 1
Me.cboFontName.AddItem Screen.Fonts(i_fra)
Next
Dim ci As ComboItem
Dim i As Integer
For i = 1 To ImgLstFont.ListImages.Count
Set ci = imgcboFontColor.ComboItems.Add(ImgLstFont.ListImages(i).Index, , , ImgLstFont.ListImages(i).Key, ImgLstFont.ListImages(i).Key, 0)
Next
Dim j As Integer
'对齐
Dim hAlign, vAlign As Boolean
For i = frmVchDefine.lDownRow To frmVchDefine.lUpRow
For j = frmVchDefine.lDownCol To frmVchDefine.lUpCol
frmVchDefine.objF1Book.SetSelection i, j, i, j
Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
If CellFormat.WordWrap Then
hAlign = True
End If
If CellFormat.WordWrap Then
hAlign = True
End If
Next
Next
Me.cboHAlign.ListIndex = CellFormat.AlignHorizontal - 1
Me.cboVAlign.ListIndex = CellFormat.AlignVertical - 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -