Excelシートの一部をピクチャーにして画像として保存する方法

Excelシートの内容をピクチャーにしてどこかに保存しておきたいといったことがまれにあります．その方法．

【用例】
Sub figure_save()

'パス名取得
Sheets("figure").Select
Cells.Select
With Selection.Font
.Name = "ＭＳ Ｐゴシック"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit
Cells(1, 1).Select
'最終行のチェック
Sheets("figure").Select
Range("B1").Select
Selection.End(xlDown).Select
encel2 = ActiveCell.Address
cend2 = Mid(encel2, 4)
Cells(1, 1).Select
'表全体の選択
Range(Cells(1, 1), Cells(cend2, 5)).Select
'表を図としてコピー貼り付け
Selection.Copy
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Pictures.ShapeRange.Name = "pic1"
'グラフのサイズを取得
ActiveSheet.Shapes("pic1").Select
hei = Selection.ShapeRange.Height
wid = Selection.ShapeRange.Width
Selection.Copy
'チャ−ト枠作成しチャートオブジェクトとして貼り付ける
Set grf = ActiveSheet.ChartObjects.Add(0, 0, wid + 8, hei + 8).Chart
grf.Paste
ggg1 = grf.Name
ggg2 = Mid(ggg1, InStr(1, ggg1, "グ", 1))

'枠線なし
ActiveSheet.ChartObjects(ggg2).Activate
ActiveChart.ChartArea.Select
Selection.Border.LineStyle = 0
'このファイルのありかを調べる
phn = ActiveWorkbook.Path
If phn = "" Then
MsgBox "ブックを1度保存してから実行して下さい"
Exit Sub
End If

'gif保存
gifname = "figure1.jpg"
grf.Export phn & "¥trend_graph¥" & gifname

'仮作成の図形削除
grf.Parent.Delete
Range("A1").Select
'ピクチャーの削除
ActiveSheet.Shapes("pic1").Select
Selection.Delete

Range("A1").Select

End Sub

【解説】

とりあえず追々ということで…

シート内のデータを消去する

プチ情報になりますが…シート内のデータを消去する設定は以下の通り．

【用法】
Sheets("100").Select
Cells.Select
Selection.Delete Shift:=xlUp
Cells(1, 1).Select

【解説】
上記のようにすると、
①シート名100を選択
②シート内の全セルを選択
③全部のデータを削除
④セル1，1を選択する

以上、簡単ですがコピペで簡単に使えるようにしておくのもよいかと思いまして書いてみました。

ADOを使ったデータベース接続でタイムアウト時間を設定する．

ADOを使ったタイムアウト時間をコントロールする為の設定．

【用法】
ADOcon.ConnectionTimeout = 300
ADOcon.CommandTimeout = 300

【解説】
ＡＤＯを使用してデータを取り出すときタイムアウトの時間を制御するのは上記のようにすればよいようです。単位は秒になります。これでちょっと重めなデータを取り出すことも出来ます。

ADOでアクセスするときに検索時間を長くする

ＡＤＯでデータベースにアクセスするときに検索時間に時間がかかってしまいタイムアウトになってしまう場合があります。いろいろ調べてみるとデフォルトでは大体30秒くらいでタイムアウトになってしまうようです。この時間を長くするためのおまじないがあります。

【用法】
編集中…

拡張子以外のファイル名を取り出す

ファイル名を取り出すのは，
filename_get = Activeworkbook.name

とやればfilename_get変数に取り出すことが出来るがこのとき.xls(拡張子）が邪魔になることがある。この拡張子以外のファイル名を取り出す方法を考えました。多分こんな風にすれば出来る。

【用例】
filename = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, Chr(46)) - 1)

【説明】
InstRevは右側からChr(46)(これは．[ドット]を表示すASCII番号)の文字のある場所を検索しそれを左側から何文字目かを取り出す関数。これとLeft関数（左側から何文字目までを切り出すか？を示す関数）を合体することで見事拡張子以外のファイル名を取り出すことが出来た。すばらしい。