调整照片大小
EXCEL
表格
关于规范使用各类表格的通知入职表格免费下载关于主播时间做一个表格详细英语字母大小写表格下载简历表格模板下载
，A列是产品图片，B列是名称，能否在B列输入名称(如123)的同时把放在E:\PIC目录下的相应货号的JPG图片调出来，且大小与A列单元格完全相符。
-模块,复制下面代码至代码框.按F5即可 用vba，按下ALT+F11,菜单:插入
Sub addpicture()
Dim FirstRow, LastRow As Integer, FileType As String
FirstRow = Sheet1.UsedRange.Row LastRow = FirstRow + Sheet1.UsedRange.Rows.Count - 1
FileType = InputBox("输入你的图片的后缀名", "输入图片格式", "jpg") For i = FirstRow To LastRow
Numb = Cells(i, 2).Value
With ActiveSheet
.Pictures.Insert("D:\tmp\" & Numb & "." & FileType).Select
Set Target = .Cells(i, 1)
End With
With Selection
.Top = Target.Top + 1
.Left = Target.Left + 1
.Width = Target.Width - 1
.Height = Target.Height - 1
End With
Next i
End Sub
Private Sub Label1_Click()
On Error GoTo ErrLabel1
Dim fileOpen As String
Dim cShape As Shape
fileOpen = Application.GetOpenFilename( "样品图片(*.jpg;*.bmp;*.gif;), *.jpg;*.bmp;*.gif;,所有文件(*.*),*.* ", , "请选择图片 ")
If fileOpen = "False " Or fileOpen = " " Then
fileOpen = " "
Exit Sub
Else
With Sheet2.Range( "A1:E3 ").Cells
picleft = .Left + .width * 0.05
pictop = .Top + .height * 0.05
picwidth = .width * 0.9
picHeight = .height * 0.9
End With
ActiveSheet.Pictures.Insert(fileOpen).Select
Dim height As Single
Dim width As Single
Dim rate As Single
height = Selection.ShapeRange.height
width = Selection.ShapeRange.width
height = picHeight / height
width = picwidth / width
rate = IIf(width > height, height, width)
Selection.ShapeRange.Left = picleft
Selection.ShapeRange.Top = pictop
Selection.ShapeRange.ScaleWidth rate, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight rate, msoFalse, msoScaleFromTopLeft
End If
ErrLabel1:
Exit Sub
End Sub
浙公网安备 33021202002483