標題: [發問] 自動貼圖編寫方式請教 [打印本頁]

---

作者: 匠夫    時間: 2011-10-20 10:48     標題: 自動貼圖編寫方式請教

本帖最後由 匠夫 於 2011-10-24 10:01 編輯

我是VBA新手完全不懂^^"，
工作報告上有大量的圖檔要貼入，
下面程式寫到快手軟.....還沒寫完，
故請教各位大大我下面編寫的方式是否能用更簡潔的語法來做。
[attach]8282[/attach]

Sub Macro1()
    Range("B264").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00000.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
   
    Range("g264").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00001.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
        
    Range("B281").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00002.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                  
    Range("G281").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00003.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
            
    Range("B298").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00004.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
               
    Range("G298").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00005.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                    
    Range("B317").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00006.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                              
    Range("G317").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00007.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                     
    Range("B334").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00008.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                
    Range("G334").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00009.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                             
    Range("B351").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00010.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                       
    Range("G351").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00011.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                 
    Range("B370").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00012.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                       
    Range("G370").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00013.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                    
    Range("B387").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00014.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
                                       
    Range("G387").Select
    ActiveSheet.Pictures.Insert( _
        "D:\test\TEK00015.PCX"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 137.25
    Selection.ShapeRange.Width = 182.25
     
                                 
End Sub

感謝版主Hsieh 熱心的幫忙

---

作者: Hsieh    時間: 2011-10-20 11:32

回復 1# 匠夫

試試看

1. Sub ex()
   
2. For i = 0 To 101 Step 2 '設置最大編號
   
3. For j = 0 To 1
   
4. fs = "D:\test\TEK" & Format(i + j, "00000") & ".PCX"
   
5.    With ActiveSheet.Pictures.Insert(fs)
   
6.     .ShapeRange.LockAspectRatio = msoTrue
   
7.     .ShapeRange.Height = 137.25
   
8.     .ShapeRange.Width = 182.25
   
9.      k = IIf(j = 0, 2, 7)
   
10.     .Top = Cells(264 + 17 * (i / 2), k).Top
    
11.     .Left = Cells(264 + 17 * (i / 2), k).Left
    
12. 
    
13.    End With
    
14. Next
    
15. Next
    
16. End Sub

複製代碼

---

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