イメージとしての範囲をエクスポート

Question

今私の同僚と私は簡単にボランティアの空席のフォームを作成するためのテンプレートを作成するためのすべての種類の方法を使用しています。

理想的には、前記プロジェクト担当者は詳細を入力するだけで、空席のフォームが自動的に生成されることが理想的です。

この時点で、フォームは自動的に完成しましたが、範囲をコピーして手動でペイントしてイメージとして保存する必要があります。また、画像の左側と左側には、調整する必要がある非常に薄い白い部分があります。

私の2つの質問は、どんなコードでも、画像としての範囲（A1：F19）の両方のエクスポートを達成することができます。薄い空白が訂正されることはありますか？

イメージがコードが実行されているフォルダと同じフォルダに保存され、ファイル名がセルJ3の名前になるのが理想的です。

私はここと他のサイトの両方で見つかったいくつかのマクロを試してきましたが、何もできませんでしたが、これは最も論理的/現実的なものでした - クレジットはOur Man In Bananasです。 Using VBA Code how to export excel worksheets as image in Excel 2003?：

dim sSheetName as string 
dim oRangeToCopy as range 
Dim oCht As Chart 

sSheetName ="Sheet1" ' worksheet to work on 
set oRangeToCopy =Range("B2:H8") ' range to be copied 

Worksheets(sSheetName).Range(oRangeToCopy).CopyPicture xlScreen, xlBitmap 
set oCht =charts.add 

with oCht 
    .paste 
    .Export FileName:="C:\SavedRange.jpg", Filtername:="JPG" 
end with 

こんにちは！ご回答有難うございます！そこで、コードを少し変更しました。拡張子を持たないファイルが作成され、画像の左上と右端に少し空白が残っていたからです。結果は次のとおりです。

Sub Tester() 
    Dim sht As Worksheet 
    Set sht = ThisWorkbook.Worksheets("Activiteit") 

    ExportRange sht.Range("A1:F19"), _ 
       ThisWorkbook.Path & "\" & sht.Range("J3").Value & ".png" 

End Sub 


Sub ExportRange(rng As Range, sPath As String) 

    Dim cob, sc 

    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 

    Set cob = rng.Parent.ChartObjects.Add(0, 0, 200, 200) 
    'remove any series which may have been auto-added... 
    Set sc = cob.Chart.SeriesCollection 
    Do While sc.Count > 0 
     sc(1).Delete 
    Loop 

    With cob 
     .Height = rng.Height 
     .Width = rng.Width 
     .Chart.Paste 
     .Chart.Export FileName:=sPath, Filtername:="PNG" 
     .Delete 
    End With 

End Sub 

ここでは1つの小さな詳細を除いて完全です。画像の周囲に（非常に）薄い灰色の境界線が表示されるようになりました。それは本当に大きな問題ではなく、訓練された目だけが気づくでしょう。それを取り除く方法がないなら、大したことはありません。しかし、ちょうどその場合、もしあなたが絶対に素晴らしい方法を知っていたら。

私はこのライン-10〜

Set cob = rng.Parent.ChartObjects.Add(0, 0, 200, 200) 

の値を変更して試してみたが、それは助けていないようでした。

Answer 1

EDITは：ChartObjectに

Sub Tester() 
    Dim sht as worksheet 
    Set sht = ThisWorkbook.Worksheets("Sheet1") 

    ExportRange sht.Range("B2:H8"), _ 
       ThisWorkbook.Path & "\" & sht.Range("J3").Value 

End Sub 


Sub ExportRange(rng As Range, sPath As String) 

    Dim cob, sc 

    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 

    Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200) 
    'remove any series which may have been auto-added... 
    Set sc = cob.Chart.SeriesCollection 
    Do While sc.Count > 0 
     sc(1).Delete 
    Loop 

    With cob 
     .ShapeRange.Line.Visible = msoFalse '<<< remove chart border 
     .Height = rng.Height 
     .Width = rng.Width 
     .Chart.Paste 
     .Chart.Export Filename:=sPath, Filtername:="PNG" 
     .Delete 
    End With 

End Sub