在模組新增以下程式碼然後執行,文字合併都正確,但圖片就無法合併直接消失,如果要連圖片一起合併的話需要怎麼修改呢?
麻煩大家回答了,感謝。
Sub 合并当前工作簿下的所有工作表()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set st = Worksheets.Add(before:=Sheets(1))
st.Name = "合并"
For Each shet In Sheets:
If shet.Name <> "合并" Then
i = st.Range("A" & Rows.Count).End(xlUp).Row + 1
shet.UsedRange.Copy
st.Cells(i, 1).PasteSpecial Paste:=xlPasteAll
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "已完成"
End Sub
Sub 合併所有工作表()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim st As Worksheet
Set st = Worksheets.Add(before:=Sheets(1))
st.Name = "合併"
For Each shet In Sheets
If shet.Name <> "合併" Then
Dim i As Long
i = st.Range("A" & Rows.Count).End(xlUp).Row + 1
shet.UsedRange.Copy
st.Cells(i, 1).PasteSpecial Paste:=xlPasteAll
Dim pic As Picture
For Each pic In shet.Pictures
pic.Copy
st.Pictures.Paste
With st.Pictures(st.Pictures.Count)
.Top = st.Cells(i, 1).Top
.Left = st.Cells(i, 1).Left
End With
Next pic
End If
Next shet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "已完成"
End Sub
非常感謝協助,但是合併後圖片雖然有到合併的資料表,可是卻重疊一起,沒有對應到欄位裡面,這是該怎麼處理呢
這個合併後要調整成文繞圖我不會弄,只能改成相對位置
我了解了,圖片本來就沒辦法綁定在欗位裡,應該是這關係吧
假設
工作表1:2行資料
工作表2:5行資料
工作表3:7行資料
因為是縱向合併所以你第一張圖片只能放在右側,並且長寬
不能超過2行,以此類推
Sub 合併所有工作表()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim st As Worksheet
Set st = Worksheets.Add(before:=Sheets(1))
st.Name = "合併"
For Each shet In Sheets
If shet.Name <> "合併" Then
Dim i As Long
i = st.Range("A" & Rows.Count).End(xlUp).Row + 1
shet.UsedRange.Copy
st.Cells(i, 1).PasteSpecial Paste:=xlPasteAll
Dim pic As Picture
For Each pic In shet.Pictures
pic.Copy
st.Pictures.Paste
With st.Pictures(st.Pictures.Count)
.Top = st.Cells(i, 1).Top + pic.Top
.Left = st.Cells(i, 1).Left + pic.Left
End With
Next pic
End If
Next shet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "已完成"
End Sub
如果要大圖或放其他位置,你在自己調整成合併中間加上幾行空白行