Board logo

標題: 一個複雜的表單問題 [打印本頁]
作者: 317    時間: 2012-7-21 10:42     標題: 一個複雜的表單問題

一個複雜的表單問題, 希望大大們能協助, 附件有明細說明, 先行謝過!!
[attach]11798[/attach]
作者: Hsieh    時間: 2012-7-25 00:50

回復 1# 317

流程總覺得有點不順，試試看有問題再討論
[attach]11837[/attach]
作者: 317    時間: 2012-7-25 07:56

回復 2# Hsieh
hsieh版大, 早晨
謝謝回應, 原來真的能做到這效果, 感激大大, 相信我要從中學習, 最後祝大大健康, 快樂..
作者: 317    時間: 2012-7-25 23:35

回復 2# Hsieh
大大:好
在表單中輸入資料時, 出現錯誤訊息, 試行修改, 但功力淺, 不成功, 請教大大再度教導, 附上檔案內有錯誤處貼圖, 謝謝!!
[attach]11841[/attach]
作者: Hsieh    時間: 2012-7-26 15:07

本帖最後由 Hsieh 於 2012-7-26 15:12 編輯

回復 4# 317

我測試沒問題，可能你沒有將檔案解壓縮到電腦位置
導致沒有權限寫入檔案
[attach]11842[/attach]
作者: 317    時間: 2012-7-26 20:41

回復 5# Hsieh
謝謝大大, 問題已解決,
祝願快樂
作者: 周大偉    時間: 2012-7-26 20:50

大大,
在這裡真是我等學習好地方, 小弟也有一問題請教, 圖片輸入時, 尺寸比例有小許偏差, 意思是指, 圖片可能變濶了, 或拉長了, 可否做到圖片比例能自動調節為於Image1控制項中, 當圖片輸入後, 圖片比例不會令照片拉長或拉濶..謝謝!!
作者: Hsieh    時間: 2012-7-26 21:20

本帖最後由 Hsieh 於 2012-7-26 21:23 編輯

回復 7# 周大偉

PictureSizeMode屬性控制
[attach]11847[/attach]
作者: 周大偉    時間: 2012-7-26 22:13

回復 8# Hsieh

明白了, 謝謝大大,
作者: 周大偉    時間: 2012-8-6 19:36

回復 8# Hsieh
hsieh版大, 好
花了一段時間, 總算能有小許領悟, 版大的技藝實太高招, 版大若能在輸入時, a欄位能自行排序, 就是否可以, 如123456- 123459- 當我輸入123457, 資料便自行排列於123456下..
煩勞大大..謝謝!
作者: Hsieh    時間: 2012-8-6 23:38

回復 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")

  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
複製代碼
作者: 周大偉    時間: 2012-8-7 00:00

回復 11# Hsieh
謝謝hsieh版大,
輸入可自行排序, 但圖片亦舊排於最尾, 不能跟資料整列顯示於插入排序之欄位. 請大大教導, 謝謝!!
作者: Hsieh    時間: 2012-8-7 00:03

本帖最後由 Hsieh 於 2012-8-7 00:13 編輯

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

    [attach]12032[/attach]
為確保圖片會隨儲存格移動
  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")

  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
複製代碼
作者: 周大偉    時間: 2012-8-7 07:53

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

回復 14# 周大偉

我測試是沒問題，有動畫為證
至於你還有問題存在，不妨上傳您的檔案看看
作者: 周大偉    時間: 2012-8-7 22:45

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

回復 15# Hsieh
hsieh版大好,
終於可以把檔案上傳, 懇請大大測試為何圖片不能排序問題, 謝謝謝!
[attach]12057[/attach]
作者: Hsieh    時間: 2012-8-8 21:00

回復 17# 周大偉
我測試沒問題
是否你沒注意到會自動編號的問題所導致呢?
[attach]12058[/attach]
作者: 周大偉    時間: 2012-8-8 21:44

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

回復 19# 周大偉
自動編號是在表單初始化的事件中，你要試著去了解修改
至於圖片是否可以排序
手動排序看看就知道了
[attach]12062[/attach]
作者: 周大偉    時間: 2012-8-8 22:56

回復 20# Hsieh
謝謝hsieh版大悉心教導, 大大用的排序是03版, 請問07版中如何運用, 因應07排序與03似有區別, 謝謝!!
作者: Hsieh    時間: 2012-8-9 00:18

回復 21# 周大偉
  1. Private Sub Label1_Click() '新增資料

  3. Dim Ar(), A As Range, B As Range, C As Range, MyPic As Shape
  4. Set dpic = CreateObject("Scripting.Dictionary")

  6. Set C = Sheet1.[A:A].Find(TextBox1.Text, lookat:=xlWhole)

  8. If Not C Is Nothing Then MsgBox ("學號重複，請重新檢查"): Exit Sub

  10. fd = ThisWorkbook.Path & "\"

  12. If Dir(fd & "Temp.bmp") <> "" Then Kill fd & "Temp.bmp"

  14. SavePicture Image1.Picture, fd & "Temp.bmp"

  16. obs = Array("TextBox1", "TextBox2", "TextBox3", "TextBox4", "TextBox5", "TextBox6", "ComboBox1", "TextBox7", "TextBox8", "TextBox9", "TextBox10", "TextBox11", "ComboBox2")


  19. For i = 0 To 12

  21.      ReDim Preserve Ar(i)

  23.      Ar(i) = Controls(obs(i)).Text

  25. Next

  27. With Sheet1

  29.    Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)

  31.    A.RowHeight = 79.8

  33.    Set B = A.Offset(, 13)

  35.    A.Resize(, 13) = Ar

  37.    Set MyPic = .Shapes.AddPicture(fd & "Temp.bmp", msoFalse, msoCTrue, B.Left, B.Top, B.Width, B.Height)

  39.    For Each pic In Sheet1.Shapes
  40.       If pic.Type = 13 Then dpic(.Cells(pic.TopLeftCell.Row, 1).Value) = pic.Name
  41.    Next

  43.    .Range("A3").CurrentRegion.Sort key1:=.[A4], Header:=xlYes  '排序
  44.    If Val(Application.Version) > 11 Then
  45.       For Each A In .Range(.[A4], .Cells(.Rows.Count, 1).End(xlUp))
  46.           .Shapes(dpic(A.Value)).Top = A.Top
  47.       Next
  48.     End If

  50. End With

  52. Unload Me: UserForm1.Show

  54. End Sub
複製代碼
作者: 周大偉    時間: 2012-8-9 07:40

回復 22# Hsieh

hsieh版大, 早晨
謝謝大大的修改, 圖片亦能排序, 真的很感動版大幫忙, 再一次衷心怠謝謝, 祝願健康, 快樂..



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)