//---------------选择图片插入---------------
Sub test()
Dim F
'F = Application.GetOpenFilename("JPG文件,*.JPG", 1, MultiSelect:=False)
F = Application.GetOpenFilename("JPG文件,*.JPG,JPEG文件,*.JPEG", 1, MultiSelect:=False)
If F = False Then Exit Sub
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("d1").Left, Range("d1").Top, Range("d1").Width, Range("d1").Height * 5).Select 'msoShapeRectangle是类别，是一个矩形
Selection.ShapeRange.Fill.UserPicture F

End Sub


//-------------------------------

//把 C3的值 复制到3，4
Sub test()
Dim F
F = Cells(3, 3)
ActiveSheet.Cells(3, "D").Value = F
End Sub


// 循环处理！
Sub test()
Dim F
Dim i As Long
For i = 3 To 20
F = Cells(i, 3)
ActiveSheet.Cells(i, "D").Value = F
Next i

End Sub
//-----------------------------------



Private Sub ListBox1_Click()
On Error Resume Next
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & "PIC" & "\" & ListBox1.Text)
End Sub

Private Sub UserForm_Initialize()
Dim xlsFile As String
On Error GoTo 100
xlsFile = Dir(ThisWorkbook.Path & "\" & "PIC" & "\" & "*.*")
 For I = 1 To 200
  ListBox1.AddItem xlsFile
  xlsFile = Dir
 Next I
 Exit Sub
100:
End Sub
//--------下载图片到相应的目录--------------

Sub test()


    Dim s, ss(), r%, i&, j&
    IName = "刘亦菲"          '这里确定要下载谁的图片
    Path = ThisWorkbook.Path & "\"
    MkDir Path & IName        '建立文件夹以便存放图片
    On Error Resume Next
    Set ie = CreateObject("Msxml2.XMLHTTP")
    For r = 0 To 100 Step 20  '这里控制你要下载几张网页的图片 _
    —如果你定的数字很大，那么恭喜你，你可以休息很长时间了，呵呵
        ie.Open "GET", "http://images.google.cn/images?gbv=2&hl=zh-CN&newwindow=1&q=" & IName & "&sa=N&start=" & r & "&ndsp=20"", true"
        ie.Send
        Do Until ie.ReadyState = 4
            DoEvents
        Loop                                '等待网页处理完成再运行下面的代码
        s = Split(ie.responseText, """")    '把源文件中的引号替换成换行，以便提取图片链接
        For i = 0 To UBound(s)
            If s(i) Like "http://*" Then
                If InStr(s(i), "jpg") Then    '这里两行查找含有图片地址的链接
                    j = j + 1
                    ReDim Preserve ss(1 To j)
                    ss(j) = s(i)              '把含有图片地址的链接址传递给数组ss
                End If
            End If
        Next
    Next
    For i = 1 To UBound(ss)
        ie.Open "GET", ss(i), False
        ie.Send
        Do Until ie.ReadyState = 4
            DoEvents
        Loop
        With CreateObject("ADODB.Stream")
            .Type = 1
            .Open
            .write ie.Responsebody
            .savetofile Path & i & ".jpg", 2   '以序号为名称另存图片
            .Close
        End With
        Name Path & i & ".jpg" As Path & IName & "\" & i & ".jpg" '把下载下来的图片移到文件夹中
    Next
End Sub
////--------------------下载图片到相应的目录--------------------------------------------


Sub test()


    Dim s, ss(), r%, i&, j&
    IName = "测试"          '这里确定要下载谁的图片
    Path = ThisWorkbook.Path & "\"
    MkDir Path & IName        '建立文件夹以便存放图片
    On Error Resume Next
    Set ie = CreateObject("Msxml2.XMLHTTP")

        ie.Open "GET", "http://img.eachbuyer.com/155-120/n/v/nv57_a.jpg ", False
        ie.Send

        With CreateObject("ADODB.Stream")
            .Type = 1
            .Open
            .write ie.Responsebody
            .savetofile Path & i & ".jpg", 2   '以序号为名称另存图片
            .Close
        End With
        Name Path & i & ".jpg" As Path & IName & "\" & i & ".jpg" '把下载下来的图片移到文件夹中

End Sub