　暱稱: VBA向前衝

帖子: 550
主題: 55
精華: 0
積分: 614
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-4-23

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2011-6-26 03:15 | 只看該作者

圖片處理問題

本帖最後由 hugh0620 於 2011-6-26 03:20 編輯

Dear 大大

      小弟有一個圖片處理的問題~ 想求知~ 該如何處理會更好
      亦有搜索過圖片的相關文章~ 沒有適當的方式
      將問題PO上來给大大們指教小弟一番
      附件是我的問題範本
      問題如下
      1. 圖片名稱的修改，是否可以直接將圖片的名稱改成編號（A、B、C…..)，以減少D欄位的資料設定。
         可直接使用編號找到圖片，然會匯出到指定的位置"
      2. 圖片匯到指定的sheet位置後會有偏移的問題，該如何處理呢?
      3. 在Output中，有一個問題，就是匯出時圖片要先清楚後，再依新的Output中C欄位的資料順序將圖片貼上，
         但是依在Output中按鈕的程式碼，會有造成錯誤，該如何修改呢?"

   Hsieh大大有提供一篇圖片的驗證方式應用~
   http://blog.xuite.net/saladoil/excel/8835494

   但不適用小弟要處理的方式~ 因為小弟的資料，會因為每次OUTPUT時資料會變動~ 無法用驗證的方式處理~
   亦考慮到使用者的EXCEL程度無法調整~ 所以~ 要死寫~ 可擴充資料的方式~ 以便利使用者使用~

圖片處理問題.rar (46.23 KB)

樓主熱帖

學習才能提升自己

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

2^#

發表於 2011-6-26 10:58 | 只看該作者

Sub 圖片命名()
Dim p As Shape
With Sheet1
For Each p In .Shapes
r = p.TopLeftCell.Row
p.Name = .Cells(r, 3).Value
Next
End With
End Sub

複製代碼

Private Sub CommandButton1_Click()
With Sheet2
'====問題點=========
For Each shp In .Shapes
If shp.Type = 13 Then shp.Delete
Next
'====問題點=========
Do Until .Range("C" & 3 + K) = ""
x = .Range("C" & 3 + K).Value
Sheet1.Shapes(x).Copy
.Select
.Paste
Selection.Top = .Range("d" & 3 + K).Top
Selection.Left = .Range("d" & 3 + K).Left
K = K + 1
Loop
End With
End Sub

複製代碼

TOP

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

帖子: 550
主題: 55
精華: 0
積分: 614
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-4-23

3^#

發表於 2011-6-26 12:34 | 只看該作者

回復 2# oobird

感謝O大大~ 程式簡單明膫只是有幾行不太了解~
等內化後~ 應該可以用的蠻應手的~

謝謝大大唷~ 感恩~ 有不了解的再請教大大~ 謝謝~ ^^

學習才能提升自己

TOP

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

帖子: 550
主題: 55
精華: 0
積分: 614
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-4-23

4^#

發表於 2011-6-27 12:16 | 只看該作者

回復 2# oobird

大大~ 我發現一個問題
如果將Output中的按鈕"圖片資料匯出"改放在Data
由data中執行匯出的動作,就會產生一個錯誤訊息
[執行階段錯誤'70': 沒有使用權限]

大大~ 我修改了好幾次~ 還是會出現這個錯誤請救一下

學習才能提升自己

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

5^#

發表於 2011-6-27 14:34 | 只看該作者

任何vba都不可能適用於所有狀況
你要自己依來源地置結構作修改
尤其是資料庫都設有存取權限

TOP

hugh0620

　暱稱: VBA向前衝

高中生 Rank: 3 Rank: 3

帖子: 550
主題: 55
精華: 0
積分: 614
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-4-23

6^#

發表於 2011-6-27 16:04 | 只看該作者

回復 5# oobird
   大大
   後來~ 我使用IF  P.TYPE<>13 THEN GOTO的方式,排除掉問題
   下面的程式碼修改/執行後沒有問題
A = Sheet1.Range("C65536").End(xlUp).Row
Sheet1.Rows("2:" & A).RowHeight = 81
Sheet1.Columns("E:E").ColumnWidth = 12.88
Dim p As Shape

With Sheet1
      For Each p In .Shapes
      If p.Type <> 13 Then GoTo 1
         R = R + 1
         p.Name = R
1
      Next

      For Each p In .Shapes
      If p.Type <> 13 Then GoTo 2
         R = p.TopLeftCell.Row
         p.Name = .Cells(R, 3).Value
         p.Top = .Cells(R, 5).Top
         p.Left = .Cells(R, 5).Left
         p.LockAspectRatio = msoFalse
         p.Height = 75
         p.Width = 73.5
2
      Next

End With

With Sheet2

'====問題點=========

For Each shp In .Shapes

If shp.Type = 13 Then shp.Delete

Next

'====問題點=========

Do Until .Range("C" & 3 + K) = ""

      x = .Range("C" & 3 + K).Value

      Sheet1.Shapes(x).Copy

      .Select

      .Paste

      Selection.Top = .Range("d" & 3 + K).Top

      Selection.Left = .Range("d" & 3 + K).Left

K = K + 1

Loop

學習才能提升自己

TOP