1234
返回列表 上一主題 發帖

有關插入圖片的問題

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
15# 跳轉到 »
發表於 2012-10-13 00:06 | 只看該作者
抱歉！還是要感謝版大熱心的教導，不過因為小弟覺得太複雜了。所以研究了這麼一段時間之後。我又去找了些語法，只是在圖片貼上之後，做一些調整移動。
    With Sheets("成績單")
    For i = 0 To j
             .Paste Destination:=.Range("d" & 22 + 26 * i)
             .Pictures.ShapeRange.IncrementLeft 45
             .Pictures.ShapeRange.IncrementTop 5
    Next i
    End With
但是又有問題ㄝ，因為迴圈會一直跑，所以會看到執行時，印章會一直不斷的移動，最前面的印章會移動最多次，甚至跑出範圍（由時會覺得很蠢！）所以又改成：
    With Sheets("成績單")
    For i = 0 To j
             .Paste Destination:=.Range("d" & 22 + 26 * i)
    Next i
             .Pictures.ShapeRange.IncrementLeft 45
             .Pictures.ShapeRange.IncrementTop 5
    End With
就是在迴圈跑完，印章都貼完之後，在一起移動圖片，但是，因為活頁簿裡也有其他圖片，所以也會跟著移動。真是傷腦筋。有沒有語法是在迴圈複製一張圖片之後，就立刻移動。下一張複製時就不會再移動到了？

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2012-10-8 16:16 | 只看該作者
回復 13# skyutm
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, M(1 To 2) As String, E As Range
  4.     Set Sh = ActiveSheet
  5.     'Set 照片位置 = Sh.[d5]
  6.     With ActiveSheet
  7.         .Pictures.Delete                                    '刪除工作表全部圖片(如還有其餘樣式的 Shape 會一併刪除)
  8.         For Each E In .[a1:a10]                            '*****[a1:a10] 已有姓名*****
  9.             M(1) = E
  10.             M(2) = Mid(E, 1, 2) & Chr(10) & Mid(E, 3, IIf(Len(E) < 3, 1, Len(E) - 2)) & "印"
  11.             With E
  12.             .FormulaR1C1 = M(2)
  13.             .Font.Size = 14
  14.             .Font.ColorIndex = 3
  15.             .Font.Name = "華康古印體(P)"                    '修改你PC上的字體
  16.             .HorizontalAlignment = xlCenter
  17.             .VerticalAlignment = xlCenter
  18.             .WrapText = True
  19.             .EntireRow.AutoFit                              '自動調整列高
  20.             .Copy
  21.         End With
  22.         With .Pictures.Paste
  23.             .Placement = xlMoveAndSize
  24.             .PrintObject = True
  25.             
  26.             '*********** 圖片貼在[B1:B10]     *******
  27.             .Top = E.Offset(, 1).Top                        '圖片:頂端位置
  28.             .Left = E.Offset(, 1).Left                      '圖片:左邊位置
  29.             E.Offset(, 1).RowHeight = E.RowHeight           '圖片貼在[B1:B10] 調整 列高
  30.             E.Offset(, 1).ColumnWidth = E.ColumnWidth       '圖片貼在[B1:B10] 調整 欄寬
  31.              '*********** 圖片貼在[B1:B10]     *******
  32.             
  33.             .ShapeRange.Fill.Visible = msoTrue              '圖片背景 顯示
  34.            ' .ShapeRange.Fill.ForeColor.SchemeColor = 41    '背景顏色
  35.              .ShapeRange.Line.Visible = msoTrue             '圖片邊框 顯示
  36.             .ShapeRange.Line.Weight = 0.75                  '邊框.厚度
  37.           '  .ShapeRange.Line.Visible = msoTrue
  38.             .ShapeRange.Line.ForeColor.SchemeColor = 10     '圖片邊框.顏色
  39.          '   .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
  40.         End With
  41.         E.Clear
  42.         E = M(1)
  43.         Next
  44.     End With
  45. End Sub
複製代碼

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
13#
發表於 2012-10-8 14:38 | 只看該作者
回復 12# stillfish00
是喔？那麼，那貼圖的位置是否有語法可以改變呢？

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
12#
發表於 2012-10-8 02:36 | 只看該作者
回復 11# skyutm
你可能誤會了 , Top和Left是指設定圖片上緣和左緣的座標位置 , 不是對齊方式~
置中一般是說文字在儲存格內的對齊方式 , 圖片應該沒這種設定?

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
11#
發表於 2012-10-7 18:53 | 只看該作者
回復 8# GBKEE
抱歉！版大又要打擾一下，小弟我想有關貼圖位置的語法應該是這一段吧
            .Top = 照片位置.Top                             '圖片:頂端位置
            .Left = 照片位置.Left                           '圖片:左邊位置
我想改成置中
            .center = 照片位置.center                            '圖片:頂端位置
            .cenetr = 照片位置.cenetr                           '圖片:左邊位置
或這樣
                .Top = 照片位置.center                             '圖片:頂端位置
               .Left = 照片位置.cenetr                           '圖片:左邊位置
或這樣
            .Top = 照片位置.xlcenetr                             '圖片:頂端位置
            .Left = 照片位置.xlcenetr                           '圖片:左邊位置
都不行，請問該如何修改呢？謝謝！

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
10#
發表於 2012-10-6 20:54 | 只看該作者
不過還是要感謝超熱心的兩位版大，這真是其他論壇無法比擬的！

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
9#
發表於 2012-10-6 20:52 | 只看該作者
回復 8# GBKEE
哇哈哈！終於讓我有機會「班門弄斧」啦。
小弟不才，但是讓我找到了mid函數，我利用mid將姓名字串分割。所以就加了一些語法：
Option Explicit
Sub Worksheet_Activate()
    Dim a, b, c As String, Sh As Worksheet, Pr As Range
    a = Sheets("基本設定").Range("i5").Value  '已輸入的姓名欄
    b = Mid(a, 1, 2)    '分割姓名
    c = Mid(a, 3, 1)    '分割姓名
    Set Sh = Sheets("印章")
    Set Pr = Sh.[b1]
    With Sh
        With .[a10]
             .FormulaR1C1 = b & Chr(10) & c & "印"      '把姓名前兩字和最後一字加上印強迫換行
             .Font.Size = 15
             .Font.ColorIndex = 3
             .Font.Name = "華康古印體(P)"
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
             .WrapText = True
             .MergeCells = False
             .Copy
        End With
        With .Pictures.Paste
             .Placement = xlMoveAndSize
             .PrintObject = True
             .Top = Pr.Top
             .Left = Pr.Left
             .ShapeRange.Fill.Visible = msoFalse
             .ShapeRange.Line.Visible = msoFalse
             .ShapeRange.Line.Weight = 1
             .ShapeRange.Line.ForeColor.SchemeColor = 10
             .Select
        End With
        .[a10] = ""
    End With
End Sub

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2012-10-6 08:05 | 只看該作者
本帖最後由 GBKEE 於 2012-10-6 08:19 編輯

回復 6# skyutm
是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, 照片位置 As Range
  4.     Set Sh = ActiveSheet
  5.     Set 照片位置 = Sh.[d5]
  6.     With Sh
  7.         .Pictures.Delete                                    '刪除工作表全部圖片(如還有其餘樣式的 Shape 會一併刪除)
  8.         With .[IV1]
  9.             .FormulaR1C1 = "李大" & Chr(10) & "明印"
  10.             .Font.Size = 14
  11.             .Font.ColorIndex = 3
  12.             .Font.Name = "華康古印體(P)"                    '修改你PC上的字體
  13.             .HorizontalAlignment = xlCenter
  14.             .VerticalAlignment = xlCenter
  15.             .WrapText = True
  16.             .MergeCells = False
  17.             .Copy
  18.         End With
  19.         With .Pictures.Paste
  20.             .Placement = xlMoveAndSize
  21.             .PrintObject = True
  22.             .Top = 照片位置.Top                             '圖片:頂端位置
  23.             .Left = 照片位置.Left                           '圖片:左邊位置
  24.             .ShapeRange.Fill.Visible = msoTrue              '圖片背景 顯示
  25.            ' .ShapeRange.Fill.ForeColor.SchemeColor = 41    '背景顏色
  26.              .ShapeRange.Line.Visible = msoTrue             '圖片邊框 顯示
  27.             .ShapeRange.Line.Weight = 0.75                  '邊框.厚度
  28.           '  .ShapeRange.Line.Visible = msoTrue
  29.             .ShapeRange.Line.ForeColor.SchemeColor = 10     '圖片邊框.顏色
  30.          '   .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
  31.         End With
  32.         .[IV1] = ""
  33.     End With
  34. End Sub
複製代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2012-10-5 22:18 | 只看該作者
回復 6# skyutm

模仿印章?

   
學海無涯_不恥下問

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
6#
發表於 2012-10-5 20:29 | 只看該作者
回復 4# GBKEE
版主大大，真是感謝，不過另外小弟又有一事相求，就是我想營造印章的感覺。
1.原本是利用文字藝術師，例如輸入 王大明，就會出現
王大
明印
但是文字藝術師無法強迫換行，所以做罷！文字藝術師只能出現  王大明印，要換行要手動去調整框框大小
2第二我是用儲存格大小與自動換行來設定，但是到了要輸出的儲存格，又會自己改變格式，所以還在另想辦法，可否以高深的功力相助？.

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
1234
返回列表 上一主題