Excelのセルの値を書式事取得
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
Excelの指定のセルの文字列を個別に書式事取得しリッチテキストボックスに表示(402)
１．Word経由でクリップボードを利用してコピー・アンド・ペーストする方法
２．１文字づつ書式情報を読み取って文末に追加書き込みする方法
動作確認 ： WindowsXP(SP2)　VB6.0(SP6) /　Excel 2000　Excel 2002　Excel 2007
プロジェクト→参照設定でMicrosoft Excel *.* Object Libraryにチェックを入れておいて下さい、Wordを使用する場合はMicrosoft Word *.* Object Library にもチェックを入れておいて下さい。
使用するコントロールは Command1 と Command2 と RichTextBox1 です。
実行結果は、下図をご覧下さい。
　 Word 経由でコピー & ペースト

Option Explicit　 'SampleNo=402　WindowsXP VB6.0(SP6)　2005.03.21
Private Sub Command1_Click()
'★プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibrary 及び
'　Microsoft Word *.* Object Library にチェックを入れておいて下さい。
'==================================================================
'Excel & Word の起動処理
　 '基本的な設定は[VBからエクセルを操作する]等を参照して下さい。
　 Dim wdApp　 As Word.Application
　 Dim wdDoc　 As Word.Document
　 Dim xlApp　 As Excel.Application
　 Dim xlBook　As Excel.Workbook
　 Dim xlSheet As Excel.Worksheet

　 Set xlApp = New Excel.Application
　 Set xlBook = xlApp.Workbooks.Open(xlFilePath())
　 Set xlSheet = xlBook.Worksheets(4)
　 Set wdApp = New Word.Application
　 Set wdDoc = wdApp.Documents.Add
'==================================================================
'セル A1 の内容をコピー
　 'エクセルの指定範囲をコピー
　 xlSheet.Range("A1").Copy　'転載禁止
　 Dim lenN As Integer
　 'セルの文字列の長さを取得
　 lenN = Len(xlSheet.Range("A1").Value)
'==================================================================
'クリップボードからWordに貼り付けそれをコピー
　 wdDoc.Select
　 wdApp.Selection.Paste　'転載禁止
　 '貼り付けた文字だけを選択（枠もコピーされるので）
　 wdApp.Selection.MoveUp Unit:=wdLine, Count:=1
　 wdApp.Selection.MoveRight Unit:=wdCharacter, _
　　　　　　　　　　　　　　　Count:=lenN, Extend:=wdExtend
　 'クリップボードにコピー
　 wdApp.Selection.Copy
'==================================================================
'RichTextBoxに貼り付け
　 'クリップボードから取得して文末にペースト
　 RichTextBox1.SelStart = Len(RichTextBox1.Text)　'転載禁止
　 RichTextBox1.SelText = Clipboard.GetText(vbCFRTF)
　 RichTextBox1.SelStart = Len(RichTextBox1.Text)
　 RichTextBox1.SelText = vbCrLf　'転載禁止
'==================================================================
'終了処理
　 xlApp.DisplayAlerts = False
　 Set xlSheet = Nothing
　 xlBook.Close
　 Set xlBook = Nothing
　 xlApp.Quit
　 Set xlApp = Nothing
　 '保存しないで終了
　 wdApp.Quit SaveChanges:=wdDoNotSaveChanges
　 Set wdDoc = Nothing
　 Set wdApp = Nothing
End Sub
　
　 Excel の文字書式を１文字づつ取得

Private Sub Command2_Click()
'★プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibraryに
'　チェックを入れておいて下さい。
'==================================================================
'Excel の起動処理
　 '基本的な設定は[VBからエクセルを操作する]等を参照して下さい。
　 Dim xlApp　 As Excel.Application
　 Dim xlBook　As Excel.Workbook
　 Dim xlSheet As Excel.Worksheet
　 Set xlApp = New Excel.Application
　 Set xlBook = xlApp.Workbooks.Open(xlFilePath())
　 Set xlSheet = xlBook.Worksheets(4)

'==================================================================
'Excel を操作部分
　 '指定のセルの個別のデータの書式情報を取得しRichTextBoxに設定する。
　 Dim i　As Long
　 Dim Co As Long
　 Dim myRange As Excel.Range
　 Set myRange = xlSheet.Range("A1")
　 Dim n As Long
　 '文末に挿入
　 n = Len(RichTextBox1.Text) ' = xlSheet.Range("A1").Value
　 For i = 1 To Len(myRange.Value)　'転載禁止
　　　Co = myRange.Characters(i, 1).Font.Color
　　　With RichTextBox1　'転載禁止
　　　　 .SelStart = n + i - 1
　　　　 .SelLength = 1
　　　　 .SelColor = myRange.Characters(i, 1).Font.Color
　　　　 .SelBold = myRange.Characters(i, 1).Font.Bold　'転載禁止
　　　　 .SelFontName = myRange.Characters(i, 1).Font.Name
　　　　 .SelFontSize = myRange.Characters(i, 1).Font.Size
　　　　 .SelItalic = myRange.Characters(i, 1).Font.Italic
　　　　 'リッチテキストボックスはアンダーラインの種類は１種類なので
　　　　 If myRange.Characters(i, 1).Font.Underline = _
　　　　　　　　　　　　　　　　　　　 xlUnderlineStyleNone Then
　　　　　　.SelUnderline = False
　　　　 Else
　　　　　　.SelUnderline = True
　　　　 End If
　　　　 .SelText = myRange.Characters(i, 1).Text
　　　End With
　 Next i
　 RichTextBox1.SelStart = Len(RichTextBox1.Text)
　 RichTextBox1.SelText = vbCrLf
'==================================================================
'終了処理
　 xlApp.DisplayAlerts = False
　 Set xlSheet = Nothing
　 xlBook.Close
　 Set xlBook = Nothing
　 xlApp.Quit
　 Set xlApp = Nothing
End Sub
　　　　Excelファイルに記入している内容です。
　　　
　　　
　　　上側がコピー・アンド・ペーストの結果で下側が1文字づつ取得の結果です
　　　
　　　
　　　コピー・アンド・ペーストした方は文字間のピッチと文字体が元のものと違っているようです。
　　　書式設定しない文字はデフォルトの設定になるようで、Excel と Word のデフォルトの
　　　文字種・フォントサイズが違うと同じようにペーストできないようです。

Excelがサポートしているクリップボードのフォーマットは、ワードより少なく直接Excelからコピー・アンド・ペーストしたのでは色情報等が付加されないのでWordを中継してペーストしております。


2005/03/21
2006/12/11


VBレスキュー(花ちゃん)
Visual Basic6.0　 VB6.0