如何增加图片类型，而不只是JPG，增加png，bmp，TIFF

菜菜行者

代码是下面链接里的，
其中有一段代码，如下：

Private Sub CommandButton1_Click()
'设定页边距
With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(1.54)     '上边距
        .BottomMargin = CentimetersToPoints(1.54)   '下边距
        .LeftMargin = CentimetersToPoints(2.5)       '左边距
        .RightMargin = CentimetersToPoints(2.5)      '右边距
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.5)
        .FooterDistance = CentimetersToPoints(1.75)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
        .LayoutMode = wdLayoutModeLineGrid
    End With
'*************************************************
'自动加入图片
Dim arr(1 To 100)
Dim i As Long
Dim j As String
Dim x As String
Dim y As String
Dim z As String
Dim a As String
Dim xlsname As String

y = "\*.jpg"
z = "\"
x = address.Value
a = number.Value
'x = "d:\debug\111"
            xlsname = Dir("" & x & y)
        For i = 1 To a
                If xlsname = "" Then
                        Exit For
                End If
                    arr(i) = xlsname
                    xlsname = Dir
If i > 2 Then
'        Next i
'    For i = 0 To 11
         j = arr(i)
    Selection.InlineShapes.AddPicture FileName:= _
        "" & x & z & j, LinkToFile:=False, SaveWithDocument:= _
        True
    Selection.TypeParagraph
   Selection.TypeText Text:=j
    Selection.TypeParagraph
   End If
    Next i
            xlsname = Dir("" & x & y)
        For i = 1 To a
                If xlsname = "" Then
                        Exit For
                End If
                    arr(i) = xlsname
                    xlsname = Dir
If i < 3 Then
'        Next i
'    For i = 0 To 11
         j = arr(i)
    Selection.InlineShapes.AddPicture FileName:= _
        "" & x & z & j, LinkToFile:=False, SaveWithDocument:= _
        True
    Selection.TypeParagraph
   Selection.TypeText Text:=j
    Selection.TypeParagraph
   End If
    Next i
    Selection.TypeBackspace
'*************************************************
'删除文件名后面的".jpg"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ".jpg"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'*************************************************
'删除文件名字里面的数字
For i = 0 To a
Select Case number.Value
Case i = i
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "" & i
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    End Select
    Next i
'*************************************************
'居中排列,黑体,四号字
    Selection.WholeStory
    Selection.Font.Size = 14
    Selection.Font.Name = "黑体"
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

'*************************************************
'所有图片设定同比例大小
    Mywidth = 16 '16为图片宽度（厘米）
    Myheigth = 12 '12为图片高度（厘米）
    For Each iShape In ActiveDocument.InlineShapes
    iShape.Height = 28.345 * Myheigth
    iShape.Width = 28.345 * Mywidth
    Next iShape
   
    '关闭窗体
    UserForm1.Hide
   
End Sub

Private Sub CommandButton2_Click()
Dim fd As FileDialog
Dim file1 As String
Dim k
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then address.Value = fd.SelectedItems(1)
Set fd = Nothing
k = 0
  file1 = Dir("" & address.Value & "\" & "*.jpg")
Do While file1 <> ""
k = k + 1
file1 = Dir
Loop
number.Value = k
End Sub

然后批量导入时只能导jpg格式的图片，略过了png，TIFF和bmp格式的图片，
请问如何修改呢，增加其他格式的图片

这是原贴
http://club.excelhome.net/thread-799195-1-1.html

duquancai

dir遍历所有文件，再根据文件后缀名判断就行了

413191246se

把相关宏代码放在一起，同时勾选几个宏，然后把 .jpg 全部替换为 .png 即可，这是临时办法。