有關插入圖片的問題

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

2^#

發表於 2012-10-3 19:03 | 只看該作者

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

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

3^#

發表於 2012-10-4 22:22 | 只看該作者

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

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2012-10-5 08:22 | 只看該作者

回復 1# skyutm
試試看

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

5^#

發表於 2012-10-5 20:22 | 只看該作者

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

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

6^#

發表於 2012-10-5 20:29 | 只看該作者

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

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2012-10-5 22:18 | 只看該作者

回復 6# skyutm

模仿印章?

學海無涯_不恥下問

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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
是這樣嗎?

Option Explicit
Sub Ex()
Dim Sh As Worksheet, 照片位置 As Range
Set Sh = ActiveSheet
Set 照片位置 = Sh.[d5]
With Sh
.Pictures.Delete '刪除工作表全部圖片(如還有其餘樣式的 Shape 會一併刪除)
With .[IV1]
.FormulaR1C1 = "李大" & Chr(10) & "明印"
.Font.Size = 14
.Font.ColorIndex = 3
.Font.Name = "華康古印體(P)" '修改你PC上的字體
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = False
.Copy
End With
With .Pictures.Paste
.Placement = xlMoveAndSize
.PrintObject = True
.Top = 照片位置.Top '圖片:頂端位置
.Left = 照片位置.Left '圖片:左邊位置
.ShapeRange.Fill.Visible = msoTrue '圖片背景顯示
' .ShapeRange.Fill.ForeColor.SchemeColor = 41 '背景顏色
.ShapeRange.Line.Visible = msoTrue '圖片邊框顯示
.ShapeRange.Line.Weight = 0.75 '邊框.厚度
' .ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.ForeColor.SchemeColor = 10 '圖片邊框.顏色
' .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End With
.[IV1] = ""
End With
End Sub

複製代碼

帖子: 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

帖子: 84
主題: 13
精華: 0
積分: 104
點名: 0
作業系統: XP
軟體版本: SP3
閱讀權限: 20
性別: 男
註冊時間: 2012-8-10
最後登錄: 2018-4-21

10^#

發表於 2012-10-6 20:54 | 只看該作者

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