图片导出问题

EJR

liucqa 发表于 2012-2-6 20:23
你用office2003或者2010做录制宏，看代码。我的是2007录不到代码

估计应该是border.linestyle之类的

录制宏代码如下：
Sub Macro6()
    ActiveSheet.ChartObjects("图表 5").Activate
    ActiveChart.ChartArea.Select
    With Selection.Border
        .Weight = 1
        .LineStyle = 0
    End With
    Selection.Interior.ColorIndex = xlAutomatic
    Sheets("Sheet1").DrawingObjects("图表 5").RoundedCorners = False
    Sheets("Sheet1").DrawingObjects("图表 5").Shadow = False
End Sub
我估计是红色部分，但我不知道怎么加到我那个代码里面，还请指点！多谢了！

guzhen9315

我以前也遇到过，没有解决。

记号，学习！

祝大家元宵节快乐！{:soso_e159:}

EJR

Sub 从Excel工作表导出图片1()
      Dim Shp As Shape
      Dim FileName As String
     For Each Shp In Sheet1.Shapes
        If Shp.Type = msoPicture Then
             FileName = ThisWorkbook.Path & "\" & Shp.Name & ".gif"
              Shp.Copy
             Set chrobj = Sheet1.ChartObjects.Add(0, 0, Shp.Width, Shp.Height) '注意度量单位
            
             'ActiveSheet.ChartObjects("图表 5").Activate
             chrobj.Select
             With Selection.Border
                  .Weight = 1
                  .LineStyle = 0
             End With            
             With chrobj.Chart
                .Paste
                  .Export FileName, "gif"
                 .Parent.Delete
             End With
         End If
      Next
End Sub
我这样加上了录制的代码，能运行。但问题依旧！请朋友帮忙！

guzhen9315

怎样去除导出图片的边框
http://club.excelhome.net/thread-614663-1-1.html

guzhen9315

通过VBA插入图片后的图片边框如何取消？
http://club.excelhome.net/thread-661684-1-1.html

EJR

guzhen9315 发表于 2012-2-6 21:42
通过VBA插入图片后的图片边框如何取消？
http://club.excelhome.net/thread-661684-1-1.html

先不说这样太麻烦，但这样做是不可能的。

香川群子

略作修改如下：

测试通过。

1. Sub 导出图片()
   
2.     Dim Shp As Shape
   
3.     Dim FileName As String
   
4.     For Each Shp In ActiveSheet.Shapes
   
5.         If Shp.Type = msoPicture Then
   
6.             FileName = ThisWorkbook.Path & "" & Shp.Name & ".gif"
   
7.             Shp.Copy
   
8.             With ActiveSheet.ChartObjects.Add(0, 0, Shp.Width, Shp.Height).Chart
   
9.                 .ChartArea.Border.LineStyle = 0 '去掉边框
   
10.                 .Paste
    
11.                 .Export FileName, "gif"
    
12.                 .Parent.Delete
    
13.             End With
    
14.         End If
    
15.     Next
    
16. End Sub
    

复制代码

香川群子

关键代码是：
.Chart.ChartArea.Border.LineStyle = 0

原始录制宏中的代码：
ActiveChart.ChartArea.Select
    With Selection.Border
        .Weight = 1
        .LineStyle = 0
    End With

应该简化为：
ActiveChart.ChartArea.Select
    With Selection.Border
        .Weight = 1
        .LineStyle = 0
    End With

省去红字部分为：
ActiveChart.ChartArea.Border.LineStyle = 0

fsc163198

Sub 从Excel工作表导出图片1()
      Dim Shp As Shape
      Dim FileName As String
     For Each Shp In Sheet1.Shapes
        If Shp.Type = msoPicture Then
             FileName = ThisWorkbook.Path & "\" & Shp.Name & ".gif"
              Shp.Copy
             Set chrobj = Sheet1.ChartObjects.Add(0, 0, Shp.Width, Shp.Height)
             chrobj.Select
             With Selection.Border
                  .Weight = 1
                  .LineStyle = 0
                  .Color = 0
             End With
             With chrobj.Chart
                .Paste
                  .Export FileName, "gif"
                 .Parent.Delete
             End With
             Shp.Delete
             ActiveSheet.Pictures.Insert(FileName).Select
         End If
      Next
End Sub

EJR

fsc163198 发表于 2012-2-6 22:16
Sub 从Excel工作表导出图片1()
      Dim Shp As Shape
      Dim FileName As String

我试了您这个代码，仍然不行，还是有边框！