Hsieh

回復 10# 周大偉

直接排序即可

1. Private Sub Label1_Click() '新增資料
   
2. Dim Ar(), A As Range, B As Range, C As Range
   
3. Set C = Sheet1.[A:A].Find(TextBox1.Text, lookat:=xlWhole)
   
4. If Not C Is Nothing Then MsgBox ("學號重複，請重新檢查"): Exit Sub
   
5. fd = ThisWorkbook.Path & "\"
   
6. If Dir(fd & "Temp.bmp") <> "" Then Kill fd & "Temp.bmp"
   
7. SavePicture Image1.Picture, fd & "Temp.bmp"
   
8. obs = Array("TextBox1", "TextBox2", "TextBox3", "TextBox4", "TextBox5", "TextBox6", "ComboBox1", "TextBox7", "TextBox8", "TextBox9", "TextBox10", "TextBox11", "ComboBox2")
   
9. 
   
10. For i = 0 To 12
    
11.      ReDim Preserve Ar(i)
    
12.      Ar(i) = Controls(obs(i)).Text
    
13. Next
    
14. With Sheet1
    
15.    Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    
16.    A.RowHeight = 79.8
    
17.    Set B = A.Offset(, 13)
    
18.    A.Resize(, 13) = Ar
    
19.    .Shapes.AddPicture fd & "Temp.bmp", msoFalse, msoCTrue, B.Left, B.Top, B.Width, B.Height
    
20.     .Range("A3").CurrentRegion.Sort key1:=.[A4], header:=xlYes  '排序
    
21. End With
    
22. Unload Me: UserForm1.Show
    
23. End Sub

複製代碼

周大偉

回復 11# Hsieh
謝謝hsieh版大,
輸入可自行排序, 但圖片亦舊排於最尾, 不能跟資料整列顯示於插入排序之欄位. 請大大教導, 謝謝!!

Hsieh

回復 12# 周大偉
圖片格式的預設值是大小位置隨儲存格而變

   

下載 (608.53 KB)

2012-8-7 00:03

為確保圖片會隨儲存格移動

1. Private Sub Label1_Click() '新增資料
   
2. Dim Ar(), A As Range, B As Range, C As Range, MyPic As Shape
   
3. Set C = Sheet1.[A:A].Find(TextBox1.Text, lookat:=xlWhole)
   
4. If Not C Is Nothing Then MsgBox ("學號重複，請重新檢查"): Exit Sub
   
5. fd = ThisWorkbook.Path & "\"
   
6. If Dir(fd & "Temp.bmp") <> "" Then Kill fd & "Temp.bmp"
   
7. SavePicture Image1.Picture, fd & "Temp.bmp"
   
8. obs = Array("TextBox1", "TextBox2", "TextBox3", "TextBox4", "TextBox5", "TextBox6", "ComboBox1", "TextBox7", "TextBox8", "TextBox9", "TextBox10", "TextBox11", "ComboBox2")
   
9. 
   
10. For i = 0 To 12
    
11.      ReDim Preserve Ar(i)
    
12.      Ar(i) = Controls(obs(i)).Text
    
13. Next
    
14. With Sheet1
    
15.    Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    
16.    A.RowHeight = 79.8
    
17.    Set B = A.Offset(, 13)
    
18.    A.Resize(, 13) = Ar
    
19.    Set MyPic = .Shapes.AddPicture(fd & "Temp.bmp", msoFalse, msoCTrue, B.Left, B.Top, B.Width, B.Height)
    
20.    MyPic.Placement = xlMoveAndSize  '設定圖片大小位置隨儲存格改變
    
21.    .Range("A3").CurrentRegion.Sort key1:=.[A4], header:=xlYes  '排序
    
22. End With
    
23. Unload Me: UserForm1.Show
    
24. End Sub

複製代碼

周大偉

回復 13# Hsieh
先行衷心怠謝謝HSIEH版大大, 小弟把程式再貼上, 排序是可以, 但上傳圖片依然是傳送至最尾, 真的不明, 勞煩大大, 是否小弟須要注意某些情況, 如屬性等. 謝謝謝!

Hsieh

回復 14# 周大偉

我測試是沒問題，有動畫為證
至於你還有問題存在，不妨上傳您的檔案看看

周大偉

回復 15# Hsieh
我的軟件像是有問題, 壓縮檔不過1mb, 格式是WinRAR 壓縮檔 (.rar), 但竟不能上傳, 試過用動畫錄制上傳, 錄了但沒有動態, 是何原因,
稍後再把檔案上傳, 希望到時能得到大大教導, 謝謝謝!

周大偉

回復 15# Hsieh
hsieh版大好,
終於可以把檔案上傳, 懇請大大測試為何圖片不能排序問題, 謝謝謝!
bb.rar (972.85 KB)

下載次數: 10

2012-8-8 19:18

Hsieh

回復 17# 周大偉
我測試沒問題
是否你沒注意到會自動編號的問題所導致呢?

下載 (919.65 KB)

2012-8-8 21:00

周大偉

回復 18# Hsieh
hsieh版大好:
看見版大輸入並沒有不妥處, 但小弟的輸入就不成功, 排序的確沒有問題, 問題是圖片不按排序插入儲存格,
我也曾留意到自動編號問題, 大大可否修改成沒有自動編號, 其實我輸入的編號是沒有固定, 如
a001-01
b001-01
111-000-001
111-000-002
請大大協助修改為沒有自動編號程式,
謝謝!!

Hsieh

回復 19# 周大偉
自動編號是在表單初始化的事件中，你要試著去了解修改
至於圖片是否可以排序
手動排序看看就知道了

下載 (305 KB)

2012-8-8 21:51