在A栏的活动表格中,我有要保存图片的文字并将其放在B栏中。
我无法弄清楚如何移除线条和轴等,只是得到范围的图像。目前,它在图像中显示线条和轴。
Sub Generate_Images()
Dim wK As Worksheet
Dim oCht As Chart
Dim i As Long, fI As Long
Dim fName As String
Application.DisplayAlerts = False
Set wK = ActiveSheet
fI = wK.Range("A" & wK.Rows.Count).End(xlUp).Row
wK.Columns("B:B").ColumnWidth = wK.Columns("A:A").ColumnWidth
For i = 1 To fI
wK.Range("A" & i).CopyPicture xlScreen, xlBitmap
Set oCht = ThisWorkbook.Charts.Add
With oCht
.ChartArea.Border.LineStyle = xlNone
.Paste
fName = ThisWorkbook.Path & "\" & Format(Now(), "DDMMYYHHMMSS") & ".png"
.Export Filename:=fName, Filtername:="PNG"
.Delete
End With
With wK.Pictures.Insert(fName)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = wK.Range("A" & i).Width
.Height = wK.Range("A" & i).Height
End With
.Left = wK.Range("B" & i).Left
.Top = wK.Range("B" & i).Top
.Placement = 1
.PrintObject = True
End With
Application.Wait Now + TimeValue("00:00:01")
Next i
Application.DisplayAlerts = True
End Sub
答案 0 :(得分:2)
为什么要导出然后重新导入图像,只需将其直接粘贴到工作表中即可?
int remainder;
char Hex[8];
int quotient, power;
remainder = (original_value*-1)-1;
for (int k = len; k > 0 ; k--)
{
if (sign == 1)
{
power = pow(16, k-1);
quotient = 15 - (remainder/power);
remainder = remainder%power;
if (quotient < 10)
Hex[len - k] = (int)quotient;
else if (quotient == 10)
Hex[len - k] = 'A';
else if (quotient == 11)
Hex[len - k] = 'B';
else if (quotient == 12)
Hex[len - k] = 'C';
else if (quotient == 13)
Hex[len - k] = 'D';
else if (quotient == 14)
Hex[len - k] = 'E';
else if (quotient == 15)
Hex[len - k] = 'F';
}
}
for(int k = 0; k < len; k++)
printf("%s", Hex[k]);
答案 1 :(得分:0)
如果将图像保存到图片文件,请尝试此操作。
相反图表,使用chartobject。可以更改图表的大小。 如果您的活动单元格不为空,Excell会根据数据自动创建图表。 因此,您必须删除图表的seriescollecton。
Sub Generate_Images()
Dim wK As Worksheet
Dim oCht As Chart
Dim i As Long, fI As Long, j As Long
Dim fName As String
Dim obj As ChartObject
Dim n As Long
Dim w As Single, h As Single
Application.DisplayAlerts = False
Set wK = ActiveSheet
wK.Pictures.Delete
fI = wK.Range("A" & wK.Rows.Count).End(xlUp).Row
wK.Columns("B:B").ColumnWidth = wK.Columns("A:A").ColumnWidth
For i = 1 To fI
w = wK.Range("A" & i).Width
h = wK.Range("A" & i).Height
wK.Range("A" & i).CopyPicture xlScreen, xlBitmap
Set obj = wK.ChartObjects.Add(Range("c1").Left, 0, w, h)
Set oCht = obj.Chart
With oCht
n = .SeriesCollection.Count
For j = n To 1 Step -1
.SeriesCollection(j).Delete
Next j
.ChartArea.Border.LineStyle = xlNone
.Paste
fName = ThisWorkbook.Path & "\" & Format(Now(), "DDMMYYHHMMSS") & ".png"
.Export Filename:=fName, Filtername:="PNG"
obj.Delete
End With
With wK.Pictures.Insert(fName)
.Left = wK.Range("B" & i).Left
.Top = wK.Range("B" & i).Top
.Placement = 1
.PrintObject = True
End With
Application.Wait Now + TimeValue("00:00:01")
Next i
Application.DisplayAlerts = True
End Sub