| |
▼rx-78gp03d さん：
おはようございます。
>テキストが入力されてないところで実行時エラーとなります。
>On Error Resume Nextで検知できるかとも思ったのですが、機能していません。
> sText = CStr(objChar.Text) '***←ここで「型が一致しません。」エラーが発生
では、上記のコードがエラーになる、ならないで分岐してみては？
>Private Sub ReadProcessFlowSheet(objSheetIN As Excel.Worksheet, objSheetOUT As Excel.Worksheet, sFile As String, lRow As Long)
>
>On Error Resume Next
>
> Dim sType As String
> Dim sText As String
> Dim objChar As Excel.Characters
> Dim objShape As Excel.Shape
>
> For Each objShape In objSheetIN.Shapes
> With objShape
> sText = ""
> sType = ""
>
> Select Case .AutoShapeType
> Case msoShapeDiamond
> sType = "フロー内接続端子（情報）"
> Case msoShapeOval
> sType = "フロー内接続端子（プロセス）"
> Case msoShapeHexagon
> sType = "画面"
> Case msoShapeCan
> sType = "データベース"
> Case msoShapePlaque
> sType = "リアルバッチ"
> Case msoShapeUTurnArrow
> sType = "問題存在箇所に戻る"
> Case msoShapePentagon
> sType = "前工程（後工程）フローからのつなぎ"
> Case msoShapeFlowchartProcess
> If .ShapeRange.Line.Style = msoLineThinThin Then
> sType = "別フロー"
> Else
> sType = "バッチ"
> End If
> Case msoShapeFlowchartPredefinedProcess
> sType = "人の作業"
> Case msoShapeFlowchartDocument
> sType = "リスト・帳票"
> Case msoShapeFlowchartStoredData
> sType = "インターフェースファイル"
> Case msoShapeRectangularCallout
> sType = "補足説明１"
> Case msoShapeCloudCallout
> sType = "補足説明２"
> Case Else
> '***対象外のオブジェクト
> sType = ""
> End Select
>
> '***対象オブジェクトの場合のみテキストの取得を実施
> If sType <> "" Then
> '***テキストが取得できる場合のみ
Err.Clear
sText = cstr(.TextFrame.Characters.Text)
If Err.number<>0 Then
sText = "テキストなし"
End If
>
> Call WriteShapeInfo(objSheetIN, objSheetOUT, objShape, sType, sText, sFile, lRow) '***これが本命の処理だが、そこまでたどり着かない
> lRow = lRow + 1
> End If
>
> End With
> Next objShape
>
>End Sub
|
|
ichinose
- 10/4/12(月) 6:51 -
