图像不随列移动(尽管设置为“随单元移动和调整大小”)

时间:2019-06-27 23:06:40

标签: excel vba

删除四拳后,我试图将图片保留在桌子旁边的桌子中。我已将其每个位置属性设置为“移动单元并调整其大小”,但是当我以编程方式执行上述操作时,它们仍然不会移动(手动完成时会起作用)

在程序中,我保存了工作簿的副本,进入该工作簿并删除了前四列,然后将该工作簿保存为html。不幸的是,当我删除前四列时,照片永远不会在它们旁边移动。

'Sets which sheets to search through and update
 sheetList = Array("CH01", "CH02", "CH03", "CH04", "CH05", "CH06", "CH07", 
 "CH08", "CH09")

 Application.ScreenUpdating = False

 'Saves and opens new workbook to process and convert to html. Workbook 
 name is skew number.xlsm

 ActiveWorkbook.SaveCopyAs _
 Filename:=ActiveWorkbook.Path & "\test.xlsm"

 Workbooks.Open (ActiveWorkbook.Path & "\test.xlsm")

 For sheetNum = LBound(sheetList) To UBound(sheetList)
     'sets sh to each sheet in sheetList
     Set sh = ActiveWorkbook.Sheets(sheetList(sheetNum))

     'Deletes first four rows of each sheet in sheetList (only way to 
      successfully hide columns once converted to html)
     sh.Columns(1).EntireColumn.Delete
     sh.Columns(1).EntireColumn.Delete
     sh.Columns(1).EntireColumn.Delete
     sh.Columns(1).EntireColumn.Delete
 Next

 Application.Wait (Now + TimeValue("0:01:00"))

 ActiveWorkbook.Save

 'Saves temp workbook as html
 ActiveWorkbook.SaveAs _
 Filename:=ActiveWorkbook.Path & "\test.html", _
 FileFormat:=xlHtml

 ActiveWorkbook.Close False

 Application.ScreenUpdating = True

如您所见,我什至让程序等待一分钟,使照片有机会更新其位置。在整个过程完成之前,我也没有更新屏幕,这是我在另一个线程上发现的唯一建议。我还在上一部分代码中将每个图片属性都设置为“ xlMoveAndSize”,并且我确定它们的位置首选项正在更新。

1 个答案:

答案 0 :(得分:1)

尝试类似的方法-激活每张图纸可能会导致删除列时形状变浅。

Dim sheetList, wbCopy As Workbook, copyName As String
Dim wbOrig As Workbook, shtName

'Sets which sheets to search through and update
sheetList = Array("CH01", "CH02", "CH03", "CH04", "CH05", _
                  "CH06", "CH07", "CH08", "CH09")

Set wbOrig = ActiveWorkbook
copyName = wbOrig.Path & "\test.xlsm"
wbOrig.SaveCopyAs Filename:=copyName

Set wbCopy = Workbooks.Open(copyName)
wbCopy.Activate

For Each shtName In sheetList
    With wbCopy.Sheets(shtName)
        .Activate
        DoEvents
        .Range("A1:D1").EntireColumn.Delete
        DoEvents
     End With
 Next

Application.Wait Now + TimeValue("0:00:10")

With wbCopy
    .Save
    .SaveAs Filename:=Replace(copyName, ".xlsm", ".html"), _
              FileFormat:=xlHtml
    .Close False
End With