144 用戶窗體的打印

在使用如圖 144 1所示的窗體錄入數(shù)據(jù)時(shí)，如果需要把窗體打印出來，可以使用PrintForm方法，如下面的代碼所示。

Private Sub CommandButton7_Click()

Dim myHeight As Integer

Application.ScreenUpdating = False

With UserForm1

myHeight = .Height

.DTPicker1.Visible = False

.Frame1.Visible = False

.Height = myHeight - 30

.PrintForm

.Height = myHeight

.DTPicker1.Visible = True

.Frame1.Visible = True

End With

Application.ScreenUpdating = True

End Sub

代碼解析：

錄入窗體中的“打印”按鈕的單擊代碼，使用PrintForm方法打印窗體。

第5行代碼使用變量myHeight記錄窗體的Height屬性值，以便在第10行代碼中恢復(fù)窗體原有的高度。

第6、7行代碼將窗體中的DTP日歷控件和功能按鈕的Visible屬性設(shè)置為False，使之隱藏，這樣在打印時(shí)就不會(huì)被打印出來。

第9行代碼使用PrintForm方法打印窗體，PrintForm方法將UserForm對(duì)象的圖象逐位發(fā)送到打印機(jī)，語法如下：

object.PrintForm

參數(shù)object代表對(duì)象表達(dá)式，其值為“應(yīng)用于”列表中的對(duì)象。如果省略該參數(shù)，則把焦點(diǎn)所在的窗體當(dāng)做object。

第11、12行代碼重新顯示窗體中的DTP日歷控件和功能按鈕。

▲145 使用自定義顏色設(shè)置窗體顏色

在用VBA進(jìn)行設(shè)計(jì)時(shí)，會(huì)發(fā)現(xiàn)控件與顏色相關(guān)的屬性中系統(tǒng)提供可選擇的顏色太少。比如窗體的BackColor屬性，如果需要把窗體的背景顏色設(shè)置為淡藍(lán)色RGB(52，150，203)，可以在窗體初始化過程中對(duì)之進(jìn)行設(shè)置，可以實(shí)現(xiàn)想要的效果，但是在設(shè)計(jì)時(shí)卻不能看到最終效果。

其實(shí)窗體的BackColor屬性(包括ForeColor以及BorderColor等等這些設(shè)置顏色的屬性)允許輸入一個(gè)以十六進(jìn)制表示的長(zhǎng)整型數(shù)值，這樣在設(shè)計(jì)時(shí)就看到效果。

首先獲取所需要的顏色值并以十六進(jìn)制表示。還以上面的顏色為例，在立即窗口輸入“? Hex(RGB(52，150，203))”可得到一個(gè)十六進(jìn)制數(shù)據(jù)CB9634，然后把光標(biāo)定位在窗體屬性窗口的BackColor屬性值中，刪除原來的數(shù)值后，輸入“&HCB9634&”后按<Enter>鍵，窗體顏色效果立即就出現(xiàn)了。

▲146 在窗體中顯示圖表

工作表中的圖表是不能直接顯示在窗體中的，如果需要在窗體上顯示圖表，除了使用▲61 介紹的使用ShowWindow屬性將工作表中嵌入的圖表顯示在獨(dú)立的窗口中，還可以使用以下的方法。

146-1 使用Export方法

可以把圖表以圖形格式從工作表中導(dǎo)出，再用窗體上的Image控件把圖表顯示出來，如下面的代碼所示。

Private Sub UserForm_Initialize()

Dim Charts As Chart

Dim cName As String

Set Charts = Sheets('Sheet2').ChartObjects(1).Chart

cName = ThisWorkbook.Path & '\Temp.gif'

Charts.Export Filename:=cName，FilterName:='GIF'

Image1.Picture = LoadPicture(cName)

End Sub

代碼解析：

窗體的初始化事件過程，窗體加載時(shí)將工作表中的圖表顯示在窗體中。

第4行到第6行代碼，使用Export方法把Sheet2表中的第一個(gè)圖表導(dǎo)出到工作簿的同一目錄下。

Export方法以圖形格式導(dǎo)出圖表，語法如下：

expression.Export(Filename，FilterName，Interactive)

參數(shù)expression是必需的，一個(gè)有效的對(duì)象。

參數(shù)Filename是必需的，導(dǎo)出的文件的名稱。

本例中設(shè)置Filename參數(shù)時(shí)加上了導(dǎo)出路徑，將圖形導(dǎo)出到同一文件夾下。

參數(shù)FilterName是可選的，導(dǎo)出文件的格式。

第7行代碼，設(shè)置窗體中Image控件的Picture屬性為導(dǎo)出文件的完整路徑。

Picture 屬性指定顯示在對(duì)象上的位圖，語法如下：

object.Picture = LoadPicture( pathname )

參數(shù)expression是必需的，一個(gè)有效的對(duì)象。

參數(shù)pathname是必需的，一個(gè)圖片文件的完整路徑。

為了使窗體關(guān)閉時(shí)刪除導(dǎo)出的圖片文件，在窗體的QueryClose事件中寫入下面的代碼。

Private Sub UserForm_QueryClose(Cancel As Integer，CloseMode As Integer)

Kill ThisWorkbook.Path & '\Temp.gif'

End Sub

代碼解析：

窗體關(guān)閉時(shí)使用Kill方法刪除導(dǎo)出的圖片文件。Kill方法的語法如下：

Kill pathname

參數(shù)Pathname是必需的，用來指定一個(gè)文件名的字符串表達(dá)式。Pathname參數(shù)可以包含目錄或文件夾、以及驅(qū)動(dòng)器。運(yùn)行窗體，將工作表的圖表顯示在窗體中。

146-2 使用API函數(shù)

可以使用API函數(shù)把圖表從工作表中導(dǎo)出，再用窗體上的Image控件把圖表顯示出來，如下面的代碼所示。

Private Declare Function CreateStreamOnHGlobal Lib 'ole32' (ByVal hGlobal As Long，ByVal fDeleteOnRelease As Long，ppstm As Any) As Long

Private Declare Function OleLoadPicture Lib 'olepro32' (pStream As Any，ByVal lSize As Long，ByVal fRunmode As Long，riid As Any，ppvObj As Any) As Long

………代碼略詳見附件

Private Declare Function GetClipboardFormatName Lib 'user32' Alias 'GetClipboardFormatNameA' (ByVal wFormat As Long，ByVal lpString As String，ByVal nMaxCount As Long) As Long

Public Function LoadShapePicture(shp As Object) As IPictureDisp

Dim nClipsize As Long

Dim hMem As Long

Dim lpData As Long

Dim sdata() As Byte

Dim fmt As Long

Dim fmtName As String

Dim iClipBoardFormatNumber As Long

Dim IID_IPicture(15)

……代碼略詳見附件

EmptyClipboard

CloseClipboard

End Function

Private Sub UserForm_Initialize()

Image1.Picture = LoadShapePicture(Sheet1.ChartObjects(1))

End Sub

代碼解析：

第1行到第12行代碼API函數(shù)聲明。

第13行到第60行代碼LoadShapePicture函數(shù)，導(dǎo)出工作表中的圖表。

第61行到第63行代碼窗體的初始化事件過程，窗體加載時(shí)將工作表中的圖表顯示在窗體中。關(guān)于Image 控件的Picture屬性請(qǐng)參閱▲146-1。

▲147 窗體運(yùn)行時(shí)調(diào)整控件大小

用戶窗體中的控件在運(yùn)行時(shí)是不能調(diào)整大小的，而在某些情況下需要在窗體運(yùn)行時(shí)調(diào)整控件的大小，此時(shí)可以利用控件的MouseMove事件。

步驟1，在VBE窗口中單擊菜單“插入”→“用戶窗體”，在窗體中添加兩個(gè)框架控件，在框架控件中間添加一個(gè)Image控件。

步驟2，Image控件是用來在窗體運(yùn)行時(shí)拖動(dòng)調(diào)整框架控件大小的，所以需要在Image控件的屬性窗口將BackStyle屬性設(shè)置為fmBackStyleTransparent，使控件的背景為透明；將BorderStyle屬性設(shè)置為fmBorderStyleNone，使控件無可見的邊框線；MousePointer屬性設(shè)置為fmMousePointerSizeWE，當(dāng)用戶把鼠標(biāo)放到Image控件上時(shí)，鼠標(biāo)指針的類型為東西向的雙箭頭。關(guān)于控件的MousePointer屬性請(qǐng)參閱▲141。

步驟3，在窗體中調(diào)整好控件的位置后雙擊Image控件寫入下面的代碼：

Dim Abscissa As Single

Private Sub Image1_MouseDown(ByVal Button As Integer，ByVal Shift As Integer，ByVal x As Single，ByVal y As Single)

Abscissa = x

End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer，ByVal Shift As Integer，ByVal x As Single，ByVal y As Single)

If Button = 1 Then

If Abscissa - x > Frame1.Width Or x > Frame2.Width Then Exit Sub

Frame1.Width = Frame1.Width - Abscissa + x

Image1.Left = Image1.Left - Abscissa + x

Frame2.Left = Frame2.Left - Abscissa + x

Frame2.Width = Frame2.Width + Abscissa - x

End If

End Sub

代碼解析：

第2行到第4行代碼，Image控件的MouseDown事件過程，用戶按下鼠標(biāo)按鍵時(shí)發(fā)生，語法如下：

Private Sub object_MouseDown( ByVal Button As fmButton，ByVal Shift As fmShiftState，ByVal X As Single，ByVal Y As Single)

其中參數(shù)x是可選的，控件位置的橫坐標(biāo)，以磅為單位，從左邊開始測(cè)量。

第3行代碼將控件的橫坐標(biāo)賦給變量Abscissa。

第5行到第12行代碼，Image控件的MouseMove事件過程，用戶移動(dòng)鼠標(biāo)時(shí)該事件發(fā)生，語法如下：

Private Sub object_MouseMove( ByVal Button As fmButton，ByVal Shift As fmShiftState，ByVal X As Single，ByVal Y As Single)

其中參數(shù)Button是必需的，標(biāo)識(shí)鼠標(biāo)按鍵狀態(tài)的整數(shù)值，其設(shè)置值如表格所示。

參數(shù)x是可選的，控件位置的水平坐標(biāo)，以磅為單位，從左邊開始測(cè)量。

在MouseMove事件過程中，當(dāng)用戶在窗體上按下左鍵移動(dòng)鼠標(biāo)時(shí)，調(diào)整兩個(gè)框架控件的Width屬性和框架2的Left屬性，使其達(dá)到窗體運(yùn)行時(shí)可以進(jìn)行拖動(dòng)調(diào)整大小的效果。

當(dāng)鼠標(biāo)指針在對(duì)象上移動(dòng)時(shí)，MouseMove事件是連續(xù)發(fā)生的，只要鼠標(biāo)位于對(duì)象的邊界之內(nèi)，對(duì)象就會(huì)不斷的識(shí)別MouseMove事件，所以框架控件可以連續(xù)的進(jìn)行拖動(dòng)調(diào)整大小。

運(yùn)行窗體的，選擇兩個(gè)框架控件的中間位置，當(dāng)鼠標(biāo)指針變成東西向的雙箭頭時(shí)按下鼠標(biāo)左鍵拖動(dòng)可以進(jìn)行拖動(dòng)調(diào)整框架控件的大小。