，大概就是在a表單(圖一)內輸入資料及相片檔名(檔案放在同一個資料夾內)，然後
可以套b表單(圖二)的表輸出b表單，節省一些文書的時間!
但是我遇到一個很棘手的問題，在我的電腦中印出都很正常，但是在其他同事的電腦
中卻是圖片不會在指定位置上出現，或者是會跳頁之類的!
請問這個跟版本有關係嗎?!還是我程式改寫得不好?
抱歉，小弟最近才剛買書自己研究怎麼寫vba，請教是否有前輩可以幫我檢視一下，謝謝
Dim Picture As String
Sub Macro1()
'
' Macro1 Macro
' 435016 在 2006/4/26 錄製的巨集
'
'
Workpath = ThisWorkbook.Path 'Workpath為目前工作路徑
For x = 1 To 500
Windows("自動異常檢核表程式2.xls").Activate '切換到自動異常檢核表程式2.xls
checkdate = Worksheets("Sheet1").Cells(3, 2).Value
Name = Worksheets("Sheet1").Cells(5, 2).Value
check_no = Worksheets("Sheet1").Cells(6 + x, 1).Value
place = Worksheets("Sheet1").Cells(6 + x, 2).Value
section = Worksheets("Sheet1").Cells(6 + x, 3).Value
Description = Worksheets("Sheet1").Cells(6 + x, 4).Value
Modify = Worksheets("Sheet1").Cells(6 + x, 5).Value
unit = Worksheets("Sheet1").Cells(6 + x, 6).Value
Picture = Worksheets("Sheet1").Cells(6 + x, 7).Value
Picture1 = Worksheets("Sheet1").Cells(6 + x, 8).Value
conter = Worksheets("Sheet1").Cells(6 + x, 9).Value
no = Worksheets("Sheet1").Cells(6 + x, 1).Value
If no = "" Then
Exit For
End If
Workbooks.Open Filename:=Workpath & "\缺失檢核空白表格3.xls" '要開啟之活頁簿的檔案名稱Workpath & "\缺失檢核空白表格2.xls
If x = 1 Then
Range("B3").Value = place
Range("F3").Value = section
Range("F1").Value = conter
Range("B10:C10").Value = Description
Range("B13:C13").Value = Modify
Range("B1").Value = check_no
Range("B2").Value = Name
Range("D2").Value = checkdate
Range("D1").Value = unit
Range("D5:F10").Select
Application.CutCopyMode = False
ActiveSheet.Pictures.Insert(Workpath & "\" & Picture).Select
Selection.ShapeRange.LockAspectRatio = msoTrue 'True 是表示如果指定的圖案會保留原來調整
Selection.ShapeRange.Height = 260#
Selection.ShapeRange.Width = 280#
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 5#
Selection.ShapeRange.IncrementTop 9#
Range("D13:F13").Select
Application.CutCopyMode = False
ActiveSheet.Pictures.Insert(Workpath & "\" & Picture1).Select
Selection.ShapeRange.LockAspectRatio = msoTrue 'True 是表示如果指定的圖案會保留原來調整
Selection.ShapeRange.Height = 260#
Selection.ShapeRange.Width = 280#
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 5#
Selection.ShapeRange.IncrementTop 9#
file_no = Workpath & "\" & no & "巡檢報告.xls"
file_no2 = no & "巡檢報告.xls"
ActiveWorkbook.SaveAs Filename:=file_no, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False '另存新檔
Else
Rows("1:20").Select
Selection.Copy
Windows(file_no2).Activate '關閉FILE_NO2視窗
y = 20 * (x - 1) + 1
Range("A" & y).Select
ActiveSheet.Paste
Cells(y + 2, 2).Value = place
Cells(y + 2, 6).Value = section
Cells(y, 2).Value = check_no
Cells(y + 1, 2).Value = Name
Cells(y + 1, 4).Value = checkdate
Cells(y, 6).Value = conter
Cells(y + 9, 2).Value = Description
Cells(y + 12, 2).Value = Modify
Cells(y, 4).Value = unit
Cells(y + 4, 4).Select
Application.CutCopyMode = False
ActiveSheet.Pictures.Insert(Workpath & "\" & Picture).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 260#
Selection.ShapeRange.Width = 280#
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 5#
Selection.ShapeRange.IncrementTop 9#
Cells(y + 12, 4).Select
Application.CutCopyMode = False
ActiveSheet.Pictures.Insert(Workpath & "\" & Picture1).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 260#
Selection.ShapeRange.Width = 280#
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 5#
Selection.ShapeRange.IncrementTop 9#
End If
Next x
ActiveWorkbook.Save
Windows("缺失檢核空白表格3.xls").Activate
ActiveWindow.Close
Windows(file_no2).Activate
ActiveWorkbook.Save
End Sub
附加壓縮檔: 201607/mobile01-7988c780177d60f99e0da0b7c668bd41.zip
