Question

我正在尝试在正确的国家/地区XLSX中插入正确的国家/地区地图JPG。通过＆＃34;纠正＆＃34;我的意思是每个XLSX都有一张地图 - Albania.jpg进入Albania.xlxs，Andorra.jpg进入Andorra.xlxs等等。

我的宏是要执行以下操作：

在用户表单工作表单元格B2和B3中输入国家/地区名称和年份（工作正常！）。
在国家/地区工作表单元格B1和E1中输入国家/地区人口和收入水平（工作正常！）。
在单元格A18的用户表单工作表中插入国家/地区地图JPG（无法将其循环播放！）。
将工作簿另存为CountryName.xlxs（工作正常！）。

我尝试过使用Filename = Dir（Path＆amp;＆＃34; *。jpg＆＃34;）和ActiveSheet.Pictures.Insert但没有成功。我想我需要使用ActiveSheet.Pictures.Insert，因为地图位置（单元格A18）上方的单元格将会展开，地图需要向下移动。

Sub SaveCountryYear_XLSX_English_map()

Dim lRow, x As Integer
Dim wbName As String
Dim MapPath As String 'Not used in example below
Dim MapName As String 'Not used in example below
Dim index As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

lRow = Range("A" & Rows.Count).End(xlUp).Row
x = 1
Do
x = x + 1

Worksheets("Countries").Activate

'1. Enter country name and year in User Form worksheet cells B2 and B3.

    Range("A" & x).Select
    Selection.Copy
    Sheets("User Form").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Countries").Select
    Range("B" & x).Select
    Selection.Copy
    Sheets("User Form").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'2. Enter country population and income level in Countries worksheet cells B1 and E1.

    Sheets("Countries").Select
    Range("C" & x).Select
    Selection.Copy
    Sheets("Table").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Countries").Select
    Range("D" & x).Select
    Selection.Copy
    Sheets("Table").Select
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'3. Insert country map JPG in User Form worksheet at cell A18 
'(cannot get this to loop!). 
'The following is just an example - it works, 
'but without loop of course (inserts the named file correctly).

    Sheets("User Form").Select
    Range("A18").Select
    ActiveSheet.Pictures.Insert( _
        "C:\temp\profiles\2017\Maps\EN JPGs\Albania_EN.jpg").Select

Sheets("Countries").Select

'4. Save the workbook as CountryName.xlxs.

    wbName = Range("A" & x).Value & "_" & Range("B" & x).Value & "_EN"
    ActiveWorkbook.SaveAs Filename:="C:\temp\profiles\2017\Production\Batch_EN_1\" _ 
        & wbName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Loop Until x = lRow

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

在OP的澄清后编辑

你可能想尝试这个重构的代码：

Option Explicit

Sub SaveCountryYear_XLSX_English_map()

    Dim wbName As String
    Dim MapPath As String 'Not used in example below
    Dim MapName As String 'Not used in example below
    Dim index As Integer  'Not used in example below
    Dim cell As Range

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False


    With Worksheets("Countries") '<--| reference "Countries" worksheet of your currently active workbook
        For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| loop through referenced worksheet column A cells filled with some text from A2 down to last not empty one

        '1. Enter country name and year in User Form worksheet cells B2 and B3.

            Worksheets("User Form").Range("B2").value = cell.value '<--| name is in current cell
            Worksheets("User Form").Range("B3").value = cell.Offset(, 1).value '<--| date is in adjacent cell

        '2. Enter country population and income level in Countries worksheet cells B1 and E1.

            Worksheets("Table").Range("B1").value = cell.Offset(, 2).value '<--| population is in cell two columns right of current one
            Worksheets("Table").Range("E1").value = cell.Offset(, 3).value '<--| income level is in cell three columns right of current one


        '3. Insert country map JPG in User Form worksheet at cell A18
        '(cannot get this to loop!).
        'The following is just an example - it works,
        'but without loop of course (inserts the named file correctly).

            Worksheets("User Form").Activate
            Range("A18").Select
            ActiveSheet.Pictures.Insert _
                "C:\temp\profiles\2017\Maps\EN JPGs\" _
                & cell.value & "_EN.jpg"


        '4. Save the workbook as CountryName.xlxs.
            Worksheets.Copy '<--| copy current workbook worksheets to a new workbook
            ActiveWorkbook.SaveAs Filename:="C:\temp\profiles\2017\Production\Batch_EN_1\" _
                & wbName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close
        Next cell

    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

其中：

你必须适应：

ActiveSheet.Pictures.Insert _
        "C:\temp\profiles\2017\Maps\EN JPGs\" _
        & cell.value & "_EN.jpg"

到您的实际文件名和源路径约定

我更改了第4部分（将工作簿另存为CountryName.xlxs）

循环以在相应命名的工作簿

1 个答案: