返回列表 上一主題 發帖

有關插入圖片的問題

有關插入圖片的問題

各位先進大家好!
        不好意思!小弟又來打擾了。小弟的問題是:我在活頁簿裡插入很多張同樣的圖片(學校的校徽),每隔幾行就會出現一張,但是在語法裡有隱藏行列的語法:
    .Cells.Rows.Hidden = False
    .Range("a" & 1 + 26 * k, .Range("a1041")).EntireRow.Hidden = True
    .Range("a1041", Range("a1041").End(xlDown)).EntireRow.Hidden = True
問題在於,有圖片的行列被隱藏,一旦又被取消隱藏之後,就會發現圖片被壓縮了。不知這個問題如何解決呢?

檔案在此,是最右邊「成績單」這個活頁簿,再次感謝!
http://www.funp.net/653900

TOP

不好意思!小弟已經在網路上和書上找到解決的方法。就是先不要複製圖片。等到隱藏儲存格的語法跑完。再來跑複製圖片的語法。這樣圖片就不會被壓縮了。

TOP

回復 4# GBKEE
唉呀!我怎麼花費這麼多時間在這兒,原來只要把選項改一改就好了,害我寫了一堆語法。不過我也從中學了一些。
像這樣先刪除圖片,以免第二次開活頁簿就會出現圖片大堆疊
    ActiveSheet.Shapes.SelectAll
    Selection.Delete
再來就是在另一個活頁簿貼圖,從那兒複製過來
     Sheets("sheet1").Shapes(1).Copy
     ActiveSheet.Paste Destination:=Sheets("成績單").Range("a" & 1 + 26 * j)

TOP

回復 4# GBKEE
版主大大,真是感謝,不過另外小弟又有一事相求,就是我想營造印章的感覺。
1.原本是利用文字藝術師,例如輸入 王大明,就會出現
王大
明印
但是文字藝術師無法強迫換行,所以做罷!文字藝術師只能出現  王大明印,要換行要手動去調整框框大小
2第二我是用儲存格大小與自動換行來設定,但是到了要輸出的儲存格,又會自己改變格式,所以還在另想辦法,可否以高深的功力相助?.

TOP

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

不過還是要感謝超熱心的兩位版大,這真是其他論壇無法比擬的!

TOP

回復 8# GBKEE
抱歉!版大又要打擾一下,小弟我想有關貼圖位置的語法應該是這一段吧
            .Top = 照片位置.Top                             '圖片:頂端位置
            .Left = 照片位置.Left                           '圖片:左邊位置
我想改成置中
            .center = 照片位置.center                            '圖片:頂端位置
            .cenetr = 照片位置.cenetr                           '圖片:左邊位置
或這樣
                .Top = 照片位置.center                             '圖片:頂端位置
               .Left = 照片位置.cenetr                           '圖片:左邊位置
或這樣
            .Top = 照片位置.xlcenetr                             '圖片:頂端位置
            .Left = 照片位置.xlcenetr                           '圖片:左邊位置
都不行,請問該如何修改呢?謝謝!

TOP

回復 12# stillfish00
是喔?那麼,那貼圖的位置是否有語法可以改變呢?

TOP

抱歉!還是要感謝版大熱心的教導,不過因為小弟覺得太複雜了。所以研究了這麼一段時間之後。我又去找了些語法,只是在圖片貼上之後,做一些調整移動。
    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

        靜思自在 : 忘功不忘過,忘怨不忘恩。
返回列表 上一主題