Sub 巨集1() '插入大張 h_f = 240 '高度 w_f = 500 '寬度 '開啟[讀取檔案]視窗 Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen) With dlgOpen .AllowMultiSelect = False '設定只能單選一張照片 .Filters.Add "照片", "*.jpg*", 1 '預設篩選jpg If .Show = -1 Then '如果按下確定 For Each vrtSelectedItem In .SelectedItems path_f = vrtSelectedItem '取得檔案位置名稱 Next '如果按下取消 Else Exit Sub End If End With '插入照片 With Selection.InlineShapes.AddPicture(FileName:=path_f, LinkToFile:=False, SaveWithDocument:=True) .LockAspectRatio = msoFalse '不鎖定長寬比 .Height = h_f '設定高度 .Width = w_f '設定寬度 End With End Sub Sub 巨集3() '插入小張 h_f = 240 '高度 w_f = 250 '寬度 '開啟[讀取檔案]視窗 Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen) With dlgOpen .AllowMultiSelect = False '設定只能單選一張照片 .Filters.Add "照片", "*.jpg*", 1 '預設篩選jpg If .Show = -1 Then '如果按下確定 For Each vrtSelectedItem In .SelectedItems path_f = vrtSelectedItem '取得檔案位置名稱 Next '如果按下取消 Else Exit Sub End If End With '插入照片 With Selection.InlineShapes.AddPicture(FileName:=path_f, LinkToFile:=False, SaveWithDocument:=True) .LockAspectRatio = msoFalse '不鎖定長寬比 .Height = h_f '設定高度 .Width = w_f '設定寬度 End With End Sub
'開啟[讀取檔案]視窗 Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen) With dlgOpen .AllowMultiSelect = False '設定只能單選一張照片 .Filters.Add "照片", "*.jpg*", 1 '預設篩選jpg If .Show = -1 Then '如果按下確定 For Each vrtSelectedItem In .SelectedItems path_f = vrtSelectedItem '取得檔案位置名稱 Next '如果按下取消 Else Exit Sub End If End With '插入照片 With Selection.InlineShapes.AddPicture(FileName:=path_f, LinkToFile:=False, SaveWithDocument:=True) .LockAspectRatio = msoFalse '不鎖定長寬比 .Height = h_f '設定高度 .Width = w_f '設定寬度 End With End Sub Sub 巨集3() '插入小張 h_f = Selection.Range.Cells(1).Height - 10 '高度=表格格子高度-10 w_f = (Selection.Range.Cells(1).Width - 10) / 2 '寬度=(表格格子寬度-10)/2 '開啟[讀取檔案]視窗 Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen) With dlgOpen .AllowMultiSelect = False '設定只能單選一張照片 .Filters.Add "照片", "*.jpg*", 1 '預設篩選jpg If .Show = -1 Then '如果按下確定 For Each vrtSelectedItem In .SelectedItems path_f = vrtSelectedItem '取得檔案位置名稱 Next '如果按下取消 Else Exit Sub End If End With '插入照片 With Selection.InlineShapes.AddPicture(FileName:=path_f, LinkToFile:=False, SaveWithDocument:=True) .LockAspectRatio = msoFalse '不鎖定長寬比 .Height = h_f '設定高度 .Width = w_f '設定寬度 End With End Sub