- 帖子
- 97
- 主題
- 31
- 精華
- 0
- 積分
- 133
- 點名
- 0
- 作業系統
- xp2007
- 軟體版本
- xp2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 香港
- 註冊時間
- 2012-8-12
- 最後登錄
- 2020-12-25
|
18#
發表於 2012-9-23 18:44
| 只看該作者
GBKEE 版大, 安好
這两天細看大大所寫的程式, 老實說, 只知道是點點, 同時亦發現一個圖片問題,
希望大大能協助, 在大大的程式中是可以運行, 但當遇上一些不支援的圖片格式
如png, 便會彈出下列提示,
執行階段錯誤91, 沒有設定物件變數或with區塊變數,
大大, 可否修改程式至任何圖片格式都可使用, 煩勞大大, 在此先行謝謝謝!!
Option Explicit '在模組層次中強迫每個在模組裏的變數都必須明確的宣告。
Private Const 編號 = 3 '資料庫的欄位列號
Private Const ThePicture = "d:\ttt.gif" '設立匯出圖片的路徑檔名
Dim Ar(10), Sh As Worksheet
Private Sub UserForm_Initialize() '表單初始化的預設事件程序
Dim I As Integer, e As Range
Set Sh = Sheets("Sheet1") '資料庫的工作表
With Sh
For Each e In .Range("a4", .[a4].End(xlDown)) '指定 ComboBox1的內容
With ComboBox1 'ComboBox1.ColumnCount=1 系統預設 顯示1欄資料
' .ColumnCount=2 '可顯示2欄資料
.AddItem
'AddItem 方法 在一個單列清單方塊或下拉式清單方塊中加入一個項目。在一個多列清單方塊或下拉式清單方塊中加入一行。
.List(.ListCount - 1, 0) = e 'ComboBox第1欄 : 字串
.List(.ListCount - 1, 1) = e.Row - 編號 'ComboBox第2欄 : 列號 1 - ....
End With
Next
End With
For I = 0 To UBound(Ar)
Set Ar(I) = Me.Controls("TextBox" & I + 1) '陣列的元素設為TextBox (物件)
Next
Image1.PictureSizeMode = fmPictureSizeModeStretch
'參數fmPictureSizeModeStretch= 1 :調整圖片大小以填滿表單或活頁，此設定會造成圖片的水平與垂直方向比例被扭曲。
End Sub
Private Sub UserForm_Click() '在表單沒有控制項的地方按下滑鼠左鍵的事件
'1當圖片傳回表單, 圖片不清, 可有方辦解決 ':修改顯示背景圖片的方式
With Image1
If .PictureSizeMode = fmPictureSizeModeClip Then
.PictureSizeMode = fmPictureSizeModeStretch
ElseIf .PictureSizeMode = fmPictureSizeModeStretch Then
.PictureSizeMode = fmPictureSizeModeZoom
ElseIf .PictureSizeMode = fmPictureSizeModeZoom Then
.PictureSizeMode = fmPictureSizeModeClip
End If
End With
' [ 常 數] [值] [ 說 明]
'fmPictureSizeModeClip 0 裁掉圖片多出來的部分 ( 預設 )。
'fmPictureSizeModeStretch 1 調整圖片大小以填滿表單或活頁，此設定會造成圖片的水平與垂直方向比例被扭曲。
'fmPictureSizeModeZoom 3 放大圖片，但不扭曲圖片水平與垂直方向的比例。
End Sub
Private Sub ComboBox1_Change()
Dim Sp As Picture, I As Integer, R As Integer
If ComboBox1.ListIndex > -1 Then '選擇 ComboBox1的內容
R = ComboBox1.List(ComboBox1.ListIndex, 1) 'ComboBox第2欄 : 列號 1....
For I = 0 To UBound(Ar)
If I <> UBound(Ar) Then
Ar(I).Text = Sh.Cells(編號 + R, I + 2) '列號 : 編號 + R
Else
'2, 在第11個TextBox11物件中, 可否做到把sheet1第11欄及12欄合拼顯示,如123aaa
Ar(I).Text = Sh.Cells(編號 + R, I + 2) & Sh.Cells(編號 + R, I + 3)
End If
Next
End If
With Sh
For Each Sp In .Pictures '尋找N欄中的圖片,複製之
If Sp.TopLeftCell.Address(0, 0) = "N" & 編號 + R Then Sp.Copy: Exit For
Next
'利用圖表匯出存檔
With .ChartObjects.Add(1, 1, Sp.Width, Sp.Height) '新增 圖表
.Chart.Paste '貼上 圖片
.Chart.Export Filename:=ThePicture '匯出 圖片
.Delete '刪除 圖表
End With
End With
Image1.Picture = LoadPicture(ThePicture) 'Image1 指定圖片
End Sub |
|
發表於 2012-9-25 23:04
| 
