| タイトル | ： Re^2: エクセルへのテキストボックス描写方法 |
| 記事No | ： 11413 |
| 投稿日 | ： 2015/04/29(Wed) 18:29 |
| 投稿者 | ： もとき |
ありがとうございました。
とても勉強になりました。
おかげさまで、エクセルは解放はできました。
本当にありがとうございます。
でも、やはり複数個の描写をさせようとした場合は、
エラーとなってしまいます。
どうか原因を、教えて頂けないでしょうか？
（エラー内容）「型 'System.Runtime.InteropServices.COMException' のハンドルされていない例外が mscorlib.dll で発生しました」
（発生場所） xlShape = xlShapes.AddTextbox(MsoTextOrientation.msoTextOrientationHorizontal, _
200, 100 + 100 * i, 100, 100)
または、
xlFont = xlTextBox.Font
xlFont.Size = 12
Option Strict On
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Core
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub cmdOK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdOK.Click
Dim FilePath As String
FilePath = "D:\VB\excel1.xlsx"
Dim xlApp As New Excel.Application
Dim xlBooks As Excel.Workbooks
Dim xlBook As Excel.Workbook
Dim xlSheets As Excel.Sheets
Dim xlSheet As Excel.Worksheet
Dim xlShapes As Excel.Shapes
Dim xlShape As Excel.Shape
Dim xlTextBox As Excel.TextBox
Dim xlShapeRange As Excel.ShapeRange
Dim xlLine As Excel.LineFormat
Dim xlColor As Excel.ColorFormat
Dim xlFont As Excel.Font
Dim xlFill As Excel.FillFormat
Dim TextBoxSu As Integer = 0
Dim TextBoxColor As Integer = 0
xlBooks = xlApp.Workbooks
xlBook = xlBooks.Open(FilePath)
xlSheets = xlBook.Worksheets
xlSheet = DirectCast(xlSheets.Item("sheet1"), Excel.Worksheet)
xlShapes = xlSheet.Shapes
'Ｅｘｃｅｌを表示する
'xlApp.Visible = True
'Ｅｘｃｅｌを表示しない
xlApp.Visible = False
'Ｅｘｃｅｌの警告メッセージを表示しない
xlApp.DisplayAlerts = False
For i As Integer = 0 To 20
xlShape = xlShapes.AddTextbox(MsoTextOrientation.msoTextOrientationHorizontal, _
200, 100 + 100 * i, 100, 100)
xlShape.Name = "textBoxName" & TextBoxSu
'〇テキストボックスへテキスト追加
xlTextBox = DirectCast(xlSheet.TextBoxes("textBoxName" & TextBoxSu), Excel.TextBox)
xlTextBox.Text = CStr(i)
MRComObject(xlShape)
TextBoxSu += 1
' 〇テキストボックス(ライン色変更)
xlShapeRange = xlTextBox.ShapeRange
xlLine = xlShapeRange.Line
xlColor = xlLine.ForeColor
xlLine.Weight = 3 '太さ
xlColor.RGB = RGB(0, 0, 255) 'ラインを青へ
MRComObject(xlColor)
MRComObject(xlLine)
MRComObject(xlShapeRange)
'〇テキストボックス フォント変更
xlFont = xlTextBox.Font
xlFont.Size = 12
MRComObject(xlFont)
'〇テキストボックス背景色変更
xlShapeRange = xlTextBox.ShapeRange
xlFill = xlShapeRange.Fill
xlColor = xlFill.ForeColor
xlColor.SchemeColor = i
MRComObject(xlColor)
MRComObject(xlFill)
MRComObject(xlShapeRange)
MRComObject(xlTextBox)
Next i
xlBook.SaveAs(FilePath, FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbook)
'▼終了処理
MRComObject(xlShapes)
MRComObject(xlSheet) 'xlSheet の解放
MRComObject(xlSheets) 'xlSheets の解放
xlBook.Close(False) 'xlBook を閉じる
MRComObject(xlBook) 'xlBook の解放
MRComObject(xlBooks) 'xlBooks の解放
xlApp.Quit() 'Excelを閉じる
MRComObject(xlApp) 'xlApp を解放
MessageBox.Show("保存しました", "メッセージ", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
'●エクセルの開放
Public Shared Sub MRComObject(Of T As Class)(ByRef objCom As T, Optional ByVal force As Boolean = False)
If objCom Is Nothing Then
Return
End If
Try
If System.Runtime.InteropServices.Marshal.IsComObject(objCom) Then
If force Then
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(objCom)
Else
Dim count As Integer = System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom)
End If
End If
Finally
objCom = Nothing
End Try
End Sub
End Class
|