FC2ブログ

Excelシートの指定範囲を画像保存する

Excelで作ったシートを帳票に張り付けたい、、、がそんなこと出来ないので、画像保存して貼り付けよう!
というわけで、Excelシートの指定範囲を画像保存するロジックを作ってみました。

※インデントを全角で付けるとコピペできないので止めました。
 見難いですがVSにコピペすれば大丈夫です(笑)
※Microsoft.Office.Interop.Excel の参照設定を忘れずに!
※環境:VisualStudio2015 / Office2019

Private oExcel As Excel.Application = Nothing
Private oBook As Excel.Workbook = Nothing
Private oSheet As Excel.Worksheet = Nothing
Private oRange As Excel.Range = Nothing
Private oRows As Excel.Range = Nothing
Private oExcelActiveWindow As Excel.Window = Nothing

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim idataPic As IDataObject = Nothing
Dim bmpData As Bitmap = Nothing

Try

Cursor.Current = Cursors.WaitCursor

oExcel = New Excel.Application

With oExcel
.Application.Visible = False
.DisplayAlerts = False
End With


With oExcel
'ファイル:オープン
oBook = .Workbooks.Open("*** ココにExcelファイルのパスを入れて下さい ***")
End With

With oBook
'ワークシート:オープン
oSheet = .Worksheets(1)
End With

With oSheet
'ワークシート:Select
.Select()

'Range:Select
oRange = .Range(.Cells(2, 2), .Cells(10, 10))
End With

' 枠線:非表示
oExcelActiveWindow = oExcel.ActiveWindow
With oExcelActiveWindow
.DisplayGridlines = False
End With


'--------------------------------------------------
' Excel:選択範囲⇒クリップボード⇒画像保存
'--------------------------------------------------

oRange.CopyPicture(Excel.XlPictureAppearance.xlScreen, Format:=Excel.XlCopyPictureFormat.xlBitmap)

idataPic = Clipboard.GetDataObject()

If idataPic.GetDataPresent(DataFormats.Bitmap) Then
bmpData = idataPic.GetData(DataFormats.Bitmap)

bmpData.Save("*** ココにExcelファイルのパスを入れて下さい ***".Text.Replace("xlsm", "jpg"), System.Drawing.Imaging.ImageFormat.Jpeg)
End If

oBook.Close(SaveChanges:=False)


MessageBox.Show("完了!", "画像変換", MessageBoxButtons.OK, MessageBoxIcon.Information)

Catch ex As System.IO.FileNotFoundException

MessageBox.Show("エラー!" & vbCrLf & ex.Message, "画像変換", MessageBoxButtons.OK, MessageBoxIcon.Error)

Finally

'--------------------------------------------------
' Excel設定:戻す
'--------------------------------------------------

'If Not oExcelActiveWindow Is Nothing Then
' With oExcelActiveWindow
' .DisplayGridlines = True
' End With
'End If

'If Not oExcel Is Nothing Then
' With oExcel
' .Application.Visible = True
' .DisplayAlerts = True
' End With
'End If


'--------------------------------------------------
' Excelオブジェクト:破棄
'--------------------------------------------------

idataPic = Nothing
bmpData = Nothing

If Not oExcelActiveWindow Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcelActiveWindow)
oRange = Nothing
End If

If Not oRange Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oRange)
oRange = Nothing
End If

If Not oSheet Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oSheet)
oSheet = Nothing
End If

If Not oBook Is Nothing Then
'oBook.Close(False)
System.Runtime.InteropServices.Marshal.ReleaseComObject(oBook)
oBook = Nothing
End If

If Not oExcel Is Nothing Then
oExcel.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcel)
oExcel = Nothing
End If

Cursor.Current = Cursors.Default

End Try

End Sub

テーマ : パソコンサポート
ジャンル : コンピュータ

WindowsUpdate後にClickOnceアプリケーションが起動しない

昨日公開された大型WindowsUpdate後に、弊社で作成/運用しているClickOnceアプリケーションが起動しなくなりました。
「Windows 10大型アップデート「April 2018 Update」 4月30日(米国時間)」


大型WindowsUpdateって何?

通常のWindowsUpdateとは別に、年2回大規模なWindowsUpdateがあります。
これは、バグなどの修正のほか、Windows機能の追加や削除など、様々な要素が含まれています。


具体的にどういう状況?

2018-06-01-05.jpg
デスクトップのショートカットをダブルクリックすると、バージョンを確認し、バージョンアップがあれば自動的に更新し起動するはずが、、、

2018-06-01-06.jpg
こんな感じの起動画面が表示されません。

2018-06-01-07.jpg
タスクマネージャで確認すると、ClickOnce自体は起動していますが、、、

2018-06-01-08.jpg
しかし、アプリケーションを直接実行すると、ちゃんと起動します。

補足)
 アプリケーションは、通常は以下のフォルダ内にあります。
 C:\Users\user\AppData\Local\Apps\2.0


原因と対策は?

ClickOnceがバージョン確認し、アプリケーションを起動させますが、アプリケーション起動後にブロックされているようです。
直接起動すると、一度警告画面が出ますが、ClickOnceがアプリケーションを起動した場合、何も出ないのであくまで予想ですが、、、そこで、以下の手順でSmartScreenをオフにしてみます。
(良いか悪いかは、とりあえず置いといて)

2018-06-01-01.jpg
"設定"から、"更新とセキュリティ"をクリックします。

2018-06-01-02.jpg
"Windowsセキュリティ"から、"アプリとブラウザの制御"をクリックします。

2018-06-01-03.jpg
"アプリとファイルの確認"を、"オフ"にします。

2018-06-01-06.jpg
すると、無事にアプリケーションが起動するようになりました(/・ω・)/


2018-06-01-04.jpg
ちなみに、この現象は、"Windowsアップデート「April 2018 Update」 Build 1803"の場合におきます。(2018.6.1現在)


【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコンサポート
ジャンル : コンピュータ

[.Net]DateTimePickerでエラー

久しぶりに、プログラミングネタです。
【VisualBasic .Net 2012】

2017-02-01-01.jpg


DateTimePickerを使っている時、以下の様なエラーになる場合があります。

Year、Month および Day パラメーターが表現できない DateTime を示しています。

2017-02-01-02.jpg


多分ですが、CustomFormatで、"yyyy/MM"の様な日付を表示しない場合に起こります。
具体的には、月を変更した際、変更前の月の月末日が、変更後の月の月末日に存在しない時に起こります。
例えば、2016年3月(内部では31日) ⇒ 2016年2月(内部では31日のまま!?) といった場合です。

私の場合、Changeイベントをハンドリングできなかったので、DateTimePickerの派生クラスを作り、その中のChangeイベントで対応しました。

2017-02-01-03.jpg
①DateTimePickerのユーザコントロールを作って、、、


2017-02-01-05.jpg
②Changeイベントで、日付を明示的にプラスマイナス1するだけです。

Public Class NewDateTimePicker
Public Sub New()
AddHandler ValueChanged, AddressOf DateTimePickerEx_ValueChanged
Value = DateTime.Now
CustomFormat = "yyyy年MM月"
Format = System.Windows.Forms.DateTimePickerFormat.Custom
End Sub

Private Sub DateTimePickerEx_ValueChanged(sender As Object, e As EventArgs)
Value = Value.AddDays(Value.Day * -1 + 1)
End Sub
End Class



2017-02-01-04.jpg
③後は、既存のコントロールを置換えるだけでOKです。



2017-02-01-06.jpg
全然関係ないですが、.Net2012と2016、併用するのが細かいところで少し面倒、、、ショートカットとか違ったりするし、、、(´・ω・`)



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : パソコンサポート
ジャンル : コンピュータ

.Net CompackFrameWork で PDA(PocketPC) を再起動

.Net CF(CompackFrameWork) で PDA(PocketPC) を再起動

今やっている開発で、どうしても定期的なPDAの再起動が必要になりました。
フリーソフトも探したければ、インストールやら設定やらと、、、
インストーラにすべて組み込めないため、数十台に配布するのはムり、、、
とても運用に耐えられない(-_-;)

というわけで、.Net(VB)CFアプリに組み込みました。
サンプルが"C"ばっかりだったので、VB板を残しておきます。
誰かの参考になれば、、、(-。-)y-゜゜゜

ちなみに、"<",">"は半角にしてね。

・開発環境).WinXP(VirtualPC)
      .NetCF(VB)2008
      .PDA(WindowsMobile5.0)
      .SQLServerCE2008


#Region "■■■ DllImport宣言 ■■■"

  '--------------------------------------------------
  ' 再起動関連
  '--------------------------------------------------

  <DllImport("CoreDll.Dll")> _
  Private Shared Function KernelIoControl( _
    ByVal dwIoControlCode As Integer, _
    ByVal lpInBuf As IntPtr, _
    ByVal nInBufSize As Integer, _
    ByVal lpOutBuf As IntPtr, _
    ByVal nOutBufSize As Integer, _
    ByRef lpBytesReturned As Integer) As Integer
  End Function

  Private Shared Sub SetCleanRebootFlag()
  End Sub

#End Region

#Region "■■■ 関数(再起動関連) ■■■"
  ''' <summary>
  ''' PDA再起動
  ''' </summary>
  ''' <remarks></remarks>
  Public Shared Sub gsHardReset()

    Dim IOCTL_HAL_REBOOT As Integer = &H101003C
    Dim bytesReturned As Integer = 0

    '起動時にハードリセットを行うフラグを立てる
    Call SetCleanRebootFlag()

    '再起動
    Call KernelIoControl(IOCTL_HAL_REBOOT, _
            IntPtr.Zero, 0, _
            IntPtr.Zero, 0, bytesReturned)

  End Sub
#End Region



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

メール送信(Windows標準のCDOオブジェクトを利用)について

メール送信(Windows標準のCDOオブジェクトを利用)

CDO(Microsoft Collaboration Data Objects)を利用したメールの送信方法についてです。
CDOの参照設定を行ったほうが,より使い易くなりますが,あえて環境に依存しない方法で
作成しました。この方法だとVB以外にも,Excel(VBA)やWSH(VBScript)でも使用できます。

下記の説明でうまくいかない場合は、サンプルをお試しください。
⇒ って、これもブログにサンプルを移植できませんでした。m(__)m

#Region "■■■ 定数宣言 ■■■"

  '--------------------------------------------------
  ' CDO関連の定数
  '--------------------------------------------------

  Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
  Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
  Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
  Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
  Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
  Private Const cdoSendUsingPort = 2
  Private Const cdoAnonymous = 0
  Private Const cdoBasic = 1
  Private Const cdoNTLM = 2
  Private Const cdoShift_JIS = "shift-jis"
  Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
  Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"

#End Region


#Region "■■■ 変数宣言 ■■■"

  '--------------------------------------------------
  ' Mail関連
  '--------------------------------------------------

  Public Structure objMail
    Public objFrom As String       '差出人
    Public objSMTPServer As String    'SMTPサーバ
    Public objSMTP_FLG As Boolean    'SMTPサーバ認証
    Public objUserName As String     'SMTPサーバ認証:ユーザ名
    Public objPassWord As String     'SMTPサーバ認証:パスワード
    Public objTo As String        '宛先(複数指定はセミコロン(;)区切りで指定可)
    Public objCC As String        'CC(複数指定はセミコロン(;)区切りで指定可)
    Public objBCC As String       'BCC(複数指定はセミコロン(;)区切りで指定可)
    Public objSubject As String     '件名
    Public objBody As String       '本文
    Public objAttachment() As String   '添付ファイル
  End Structure

#End Region


#Region "■■■ 関数 ■■■"
  '==============================================================================
  '
  ' メール送信
  '
  ' ------------------------------------------------------------------------
  ' 説明 : メールオブジェクトの内容にしたがってメールを送信する
  '
  ' ------------------------------------------------------------------------
  ' 引数 : objMailSet     メールオブジェクトセット
  '    strErrMsg      エラーメッセージ
  ' 戻値 : True:成功、False:失敗
  '
  '==============================================================================

  Public Function fncMailSend(ByVal objMailSet As objMail, _
                Optional ByRef strErrMsg As String = "") As Boolean

    Dim oMsg As Object
    Dim intCnt As Integer

    Try

      '--------------------------------------------------
      ' メール送信
      '--------------------------------------------------

      'CDOオブジェクト作成
      oMsg = CreateObject("CDO.Message")

      'CDOオブジェクト設定&送信
      With oMsg
        '差出人
        .From = objMailSet.objFrom

        '宛先,件名,本文設定
        .To = objMailSet.objTo
        .CC = objMailSet.objCC
        .BCC = objMailSet.objBCC
        .Subject = objMailSet.objSubject
        .TextBody = objMailSet.objBody

        '添付ファイル設定
        For intCnt = 0 To objMailSet.objAttachment.GetUpperBound(0)
          If objMailSet.objAttachment(intCnt).ToString <> "" Then
            .AddAttachment(objMailSet.objAttachment(intCnt).ToString)
          End If
        Next

        'SMTPサーバ設定
        If objMailSet.objSMTPServer <> "" Then
          With .Configuration.Fields

            'SMTPサーバ
            .Item(cdoSendUsingMethod) = cdoSendUsingPort
            .Item(cdoSMTPServer) = objMailSet.objSMTPServer
            .Item(cdoSMTPServerPort) = 25

            'SMTP認証
            If objMailSet.objSMTP_FLG Then
              .Item(cdoSMTPAuthenticate) = cdoAnonymous
              .Item(cdoSendUserName) = objMailSet.objUserName
              .Item(cdoSendPassword) = objMailSet.objPassWord
            End If

            '設定更新
            .Update()
          End With
        End If

        'メール送信
        .Send()

      End With

      'CDOオブジェクト解放
      oMsg = Nothing


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return True

    Catch ex As Exception

      '--------------------------------------------------
      ' エラーメッセージ設定
      '--------------------------------------------------

      strErrMsg = "メール送信中にエラーが発生しました。" & vbCrLf & _
            "ネットワーク管理者(プロバイダ)にお問い合わせください。" & vbCrLf & _
            "詳細は以下のとおり" & vbCrLf & _
            ex.Message


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return False

    End Try

  End Function
#End Region



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。

テーマ : プログラミング
ジャンル : コンピュータ

検索フォーム
最新記事
カテゴリ
全記事表示リンク

全ての記事を表示する

最新コメント
プロフィール

ITLife

Author:ITLife
システム葵新井聡太です。
東京都東村山市に生まれ、ここで育ち、ここで結婚し、システムエンジニア一筋で十数年やってきました。
ここでは主に、パソコンを中心にITに関わることを備忘録として残していきたいと思います。
少しでも来ていただいた方のお役に立てたら幸いです。
m(_ _)m

p.s
ここで紹介している内容は一例です。すべては、自己責任でお願いします。

カレンダー
06 | 2019/07 | 08
- 1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31 - - -
訪問数
月別アーカイブ
リンク