![[CX's MEMO]](image/cx_memo.jpg "[CX's MEMO]")
Sub AddShape()
Dim shpObj
Dim n
' テストデータ
n = 5
Dim strArray()
ReDim strArray(n - 1)
strArray(0) = "Message1"
strArray(1) = "Message2"
strArray(2) = "Message3"
strArray(3) = "Message4"
strArray(4) = "Message5"
Dim i
For i = 0 To n - 1
' DrawRectangle により四角形を描画します
' パラメータは x1, y1, x2, y2 （単位：インチ）
Set shpObj = ActivePage.DrawRectangle(0, i, 1, i + 1)
' シェイプオブジェクトに文字列を設定
shpObj.Text = strArray(i)
Next
End SubSub AddShapeFromExcel()
Dim strFileName
Dim strSheetName
strFileName = "D:\home\edu\hatena\visio_vba\test.xls" ' テストデータ
strSheetName = "SampleSheet" ' シート名
' ADO を利用して Excel ファイルをオープンする
Dim cn
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName & ";Extended Properties=Excel 8.0"
' ADO を利用して Excel のシートのデータをレコードセットにセットする
Dim rs
Set rs = cn.Execute("SELECT * FROM [Excel 8.0;database=" & strFileName & "].[" & strSheetName & "$]")
Dim shpObj
' レコード件数分ループする
While Not rs.BOF And Not rs.EOF
' 四角形を作成する
Set shpObj = ActivePage.DrawRectangle(0, 0, 1, 1)
' 四角形にテキストデータを挿入する
shpObj.Text = rs(0)
'次のレコードに移動する
rs.MoveNext
Wend
End Sub
