Option Explicit
Private oRFC As Object 'BAPI
Private wsMain As Worksheet 'メインのワークシート
Private SapLanguage As String 'ログイン中の言語
'ワークシートの行と列の番号
Private ROW_HEADER As Long '見出し行
Private ROW_DATA_START As Long 'データの開始行
Private COL_COMP_CODE As Integer '会社コード
Private COL_MATERIAL As Integer '品目コード
Private COL_PLANT As Integer 'プラント
Private COL_SALESORG As Integer '販売組織
Private COL_DISTR_CHAN As Integer '流通チャネル
Private COL_VAL_AREA As Integer '評価レベル
Private COL_MESSAGE As Integer 'メッセージ
Private COL_MATL_DESC As Integer '品目テキスト
'テーブルの項目情報を格納するユーザタイプ
Private Type TABL_FIELDS
FIELDNAME As String 'フィールド技術名
FLABEL As String '項目ラベル
End Type
'****************************************************************************************
' 処理名 ：Exec_BAPI
' 機能 ：BAPI:BAPI_MATERIAL_GET_ALLを実行し、品目マスタの全項目の値を取得・表示する
' 返り値 ：なし
' 引数 ：なし
'****************************************************************************************
Public Sub Exec_BAPI()
On Error GoTo Err_Exec_BAPI
Dim RowLast As Long '最終行
Dim ColLast As Integer '最終列
Dim aCells() As Variant 'ワークシートのセル範囲に対応する配列
Dim CountMaterial As Long '処理件数のカウント
Dim aCLIENTDATA() As TABL_FIELDS '一般データ
Dim aPLANTDATA() As TABL_FIELDS 'プラントデータ
Dim aSALESDATA() As TABL_FIELDS '販売データ
Dim aVALUATIONDATA() As TABL_FIELDS '評価データ
Dim Material As String '品目コード
Dim Plant As String 'プラント
Dim SalesOrg As String '販売組織
Dim DistrChan As String '流通チャネル
Dim ValArea As String '評価レベル
Dim Message As String 'メッセージ
Dim ColDataStart As Integer 'データの開始列(品目テキストの右隣り)
Dim ColPlant As Integer 'プラントデータの開始列
Dim ColSales As Integer '販売データの開始列
Dim ColValue As Integer '評価データの開始列
Dim Row As Long
Dim Col As Integer
Dim i As Integer
'SAPログオン状態の確認
If SapChkAndLogon() <> 0 Then Exit Sub
'SAPにログイン中の言語
SapLanguage = Trim(Worksheets("Logon Setting").Range("Language"))
'*** テーブルの項目情報を取得するRPY_TABLE_READの宣言
goSapFunction.RemoveAll
Set oRFC = goSapFunction.Add("RPY_TABLE_READ")
oRFC.Exports("LANGUAGE") = SapLanguage
'処理対象のワークシートを変数にセット
Set wsMain = ActiveSheet
'列番号のセット
Call SetColNumber
ColDataStart = COL_MATL_DESC + 1
With wsMain
'最終セルの位置の取得
RowLast = CLng(.Cells(ROW_DATA_START, 1).SpecialCells(xlLastCell).Row)
ColLast = CInt(.Cells(ROW_DATA_START, COL_MESSAGE + 1).SpecialCells(xlLastCell).Column)
'*** ワークシートに品目マスタのフィールドを表示するための列を動的に作成する
'表示する列とデータ領域の事前消去
.Range(.Cells(ROW_DATA_START, COL_MESSAGE), .Cells(RowLast, COL_MESSAGE + 1)).ClearContents
.Range(.Cells(ROW_DATA_START, COL_MESSAGE + 1), .Cells(RowLast, ColLast)).ClearContents
.Range(.Cells(ROW_HEADER, COL_MESSAGE + 2), .Cells(RowLast, ColLast)).ClearContents
'一般データ列の作成
If RPY_TABLE_READ("BAPI_MARA_GA", aCLIENTDATA) = 0 Then
ReDim aCells(0 To 2, 0 To UBound(aCLIENTDATA))
For i = 0 To UBound(aCLIENTDATA)
aCells(0, i) = aCLIENTDATA(i).FLABEL
aCells(1, i) = "CLIENTDATA"
aCells(2, i) = aCLIENTDATA(i).FIELDNAME
Next
Else
Call SapLogoff
Exit Sub
End If
.Range(.Cells(ROW_HEADER, ColDataStart), .Cells(ROW_HEADER + 2, ColDataStart + UBound(aCLIENTDATA))).Value = aCells
'プラントデータ列の作成
If RPY_TABLE_READ("BAPI_MARC_GA", aPLANTDATA) = 0 Then
ReDim aCells(0 To 2, 0 To UBound(aPLANTDATA))
For i = 0 To UBound(aPLANTDATA)
aCells(0, i) = aPLANTDATA(i).FLABEL
aCells(1, i) = "PLANTDATA"
aCells(2, i) = aPLANTDATA(i).FIELDNAME
Next
Else
Call SapLogoff
Exit Sub
End If
ColPlant = ColDataStart + UBound(aCLIENTDATA) + 1
.Range(.Cells(ROW_HEADER, ColPlant), .Cells(ROW_HEADER + 2, ColPlant + UBound(aPLANTDATA))).Value = aCells
'販売データ列の作成
If RPY_TABLE_READ("BAPI_MVKE_GA", aSALESDATA) = 0 Then
ReDim aCells(0 To 2, 0 To UBound(aSALESDATA))
For i = 0 To UBound(aSALESDATA)
aCells(0, i) = aSALESDATA(i).FLABEL
aCells(1, i) = "SALESDATA"
aCells(2, i) = aSALESDATA(i).FIELDNAME
Next
Else
Call SapLogoff
Exit Sub
End If
ColSales = ColPlant + UBound(aPLANTDATA) + 1
.Range(.Cells(ROW_HEADER, ColSales), .Cells(ROW_HEADER + 2, ColSales + UBound(aSALESDATA))).Value = aCells
'評価データ列の作成
If RPY_TABLE_READ("BAPI_MBEW_GA", aVALUATIONDATA) = 0 Then
ReDim aCells(0 To 2, 0 To UBound(aVALUATIONDATA))
For i = 0 To UBound(aVALUATIONDATA)
aCells(0, i) = aVALUATIONDATA(i).FLABEL
aCells(1, i) = "VALUATIONDATA"
aCells(2, i) = aVALUATIONDATA(i).FIELDNAME
Next
Else
Call SapLogoff
Exit Sub
End If
ColValue = ColSales + UBound(aSALESDATA) + 1
.Range(.Cells(ROW_HEADER, ColValue), .Cells(ROW_HEADER + 2, ColValue + UBound(aVALUATIONDATA))).Value = aCells
'*** 品目マスタの全項目を取得するBAPI_MATERIAL_GET_ALLの宣言
goSapFunction.RemoveAll
Set oRFC = goSapFunction.Add("BAPI_MATERIAL_GET_ALL")
'*** 入力されている品目マスタの行だけ繰り返し処理
For Row = ROW_DATA_START To RowLast
'品目コードの取得
Material = Trim(.Cells(Row, COL_MATERIAL))
'品目コードが未入力の時、処理をスキップ
If Material = "" Then GoTo ContinueLoop
'処理件数をカウント
CountMaterial = CountMaterial + 1
'*** Importパラメータ(検索条件)の設定
'品目コード
oRFC.Exports("MATERIAL") = Material
'会社コード
oRFC.Exports("COMP_CODE") = Trim(.Cells(Row, COL_COMP_CODE))
'プラント
Plant = Trim(.Cells(Row, COL_PLANT))
oRFC.Exports("PLANT") = Plant
'販売組織
SalesOrg = Trim(.Cells(Row, COL_SALESORG))
oRFC.Exports("SALESORG") = SalesOrg
'流通チャネル
DistrChan = Trim(.Cells(Row, COL_DISTR_CHAN))
oRFC.Exports("DISTR_CHAN") = DistrChan
'評価クラス
ValArea = Trim(.Cells(Row, COL_VAL_AREA))
oRFC.Exports("VAL_AREA") = ValArea
'*** BAPI_MATERIAL_GET_ALLの実行
If oRFC.Call = False Then
'BAPI実行時エラーの時はエラーメッセージを表示してループを抜ける
MsgBox oRFC.Exception, vbExclamation
Exit For
End If
'メッセージの表示
If oRFC.Tables("RETURN").RowCount > 0 Then
Message = oRFC.Tables("RETURN").Value(1, "MESSAGE")
For i = 2 To oRFC.Tables("RETURN").RowCount
Message = Message & vbLf & oRFC.Tables("RETURN").Value(i, "MESSAGE")
Next
.Cells(Row, COL_MESSAGE) = Message
End If
'品目テキストの表示
For i = 1 To oRFC.Tables("MATERIALDESCRIPTION").RowCount
'ログイン中の言語と一致するテキストを表示
If oRFC.Tables("MATERIALDESCRIPTION").Value(i, "LANGU_ISO") = SapLanguage Then
.Cells(Row, COL_MATL_DESC) = oRFC.Tables("MATERIALDESCRIPTION").Value(i, "MATL_DESC")
Exit For
End If
Next
'*** 一般データの表示
ReDim aCells(0 To 0, 0 To UBound(aCLIENTDATA))
For i = 0 To UBound(aCLIENTDATA)
aCells(0, i) = oRFC.Imports("CLIENTDATA").Value(aCLIENTDATA(i).FIELDNAME)
Next
.Range(.Cells(Row, ColDataStart), .Cells(Row, ColDataStart + UBound(aCLIENTDATA))).Value = aCells
'*** プラントデータの表示
If Plant <> "" Then
ReDim aCells(0 To 0, 0 To UBound(aPLANTDATA))
For i = 0 To UBound(aPLANTDATA)
aCells(0, i) = oRFC.Imports("PLANTDATA").Value(aPLANTDATA(i).FIELDNAME)
Next
.Range(.Cells(Row, ColPlant), .Cells(Row, ColPlant + UBound(aPLANTDATA))).Value = aCells
End If
'*** 販売データの表示
If SalesOrg <> "" And DistrChan <> "" Then
ReDim aCells(0 To 0, 0 To UBound(aSALESDATA))
For i = 0 To UBound(aSALESDATA)
aCells(0, i) = oRFC.Imports("SALESDATA").Value(aSALESDATA(i).FIELDNAME)
Next
.Range(.Cells(Row, ColSales), .Cells(Row, ColSales + UBound(aSALESDATA))).Value = aCells
End If
'*** 評価データの表示
ReDim aCells(0 To 0, 0 To UBound(aVALUATIONDATA))
For i = 0 To UBound(aVALUATIONDATA)
aCells(0, i) = oRFC.Imports("VALUATIONDATA").Value(aVALUATIONDATA(i).FIELDNAME)
Next
.Range(.Cells(Row, ColValue), .Cells(Row, ColValue + UBound(aVALUATIONDATA))).Value = aCells
ContinueLoop:
Next
End With
'ログオフ
Call SapLogoff
'処理終了メッセージの表示
MsgBox "処理完了" & vbLf & "処理件数 = " & CStr(CountMaterial), vbInformation, "品目マスタ全項目表示処理"
Exit Sub
Err_Exec_BAPI:
'エラー発生時
MsgBox Err.Description, vbCritical
End Sub
'****************************************************************************************
' 処理名 ：SetColNumber
' 機能 ：ワークシートのセル範囲より、ワークシートの列番号をセットする
' 返り値 ：なし
' 引数 ：なし
'****************************************************************************************
Private Sub SetColNumber()
ROW_HEADER = wsMain.Range("ROW_HEADER").Row
ROW_DATA_START = wsMain.Range("ROW_DATA_START").Row
COL_COMP_CODE = wsMain.Range("COMP_CODE").Column
COL_MATERIAL = wsMain.Range("MATERIAL").Column
COL_PLANT = wsMain.Range("PLANT").Column
COL_SALESORG = wsMain.Range("SALESORG").Column
COL_DISTR_CHAN = wsMain.Range("DISTR_CHAN").Column
COL_VAL_AREA = wsMain.Range("VAL_AREA").Column
COL_MESSAGE = wsMain.Range("MESSAGE").Column
COL_MATL_DESC = wsMain.Range("MATL_DESC").Column
End Sub
'****************************************************************************************
' 処理名 ：RPY_TABLE_READ
' 機能 ：BAPI:RPY_TABLE_READを実行し、テーブルの項目情報を取得する
' 返り値 ：aCells 項目情報を格納するユーザタイプ型の配列
' 引数 ：Table テーブル名
' aCells 項目情報を格納するユーザタイプ型の配列
'****************************************************************************************
Private Function RPY_TABLE_READ(ByVal Table As String, ByRef aCells() As TABL_FIELDS) As Long
On Error GoTo Err_RPY_TABLE_READ
Dim CountTable As Integer
Dim i As Integer
oRFC.Exports("TABLE_NAME") = Table
oRFC.Tables("TABL_FIELDS").Rows.RemoveAll
If oRFC.Call = False Then
MsgBox oRFC.Exception, vbCritical
RPY_TABLE_READ = 1
Exit Function
End If
CountTable = oRFC.Tables("TABL_FIELDS").RowCount
ReDim aCells(0 To CountTable - 1)
With oRFC.Tables("TABL_FIELDS")
'テーブルのフィールド名と項目ラベルを配列にセットする
For i = 1 To CountTable
aCells(i - 1).FIELDNAME = .Value(i, "FIELDNAME")
'aCells(i - 1).FLABEL = .Value(i, "SCRTEXT_S") '項目ラベル短
'aCells(i - 1).FLABEL = .Value(i, "SCRTEXT_M") '項目ラベル中
'aCells(i - 1).FLABEL = .Value(i, "SCRTEXT_L") '項目ラベル長
aCells(i - 1).FLABEL = .Value(i, "DDTEXT") '説明テキスト
Next
End With
RPY_TABLE_READ = 0
Exit Function
Err_RPY_TABLE_READ:
RPY_TABLE_READ = Err.Number
MsgBox Err.Description, vbCritical
End Function
Excelマクロファイルの動作環境とダウンロード
動作環境
本マクロ（Excelファイル）は、以下の環境で動作可能である。
Excelマクロの動作環境
Microsoft Excel デスクトップ版 32 or 64ビット
Web版のExcelは動作対象外
SAP GUI for Windows 7.70 以上
Microsoft Excel のビット数と SAP GUI for Windows のビット数は同じなければ動作しない。 たとえば、64ビットの Excel を利用中なら、SAP GUI for Windows も64ビット版である必要がある。
この利用規約（以下「本規約」とします）は、Ke1G（以下、乙とします）が運営するウェブサイト「SAP × AI Insights Blog（https://ke1gtech.com/）」（以下「当サイト」とします）で公開している便利ツール・プログラム（以下「本プログラム」という）をダウンロードして利用する者（以下「利用者」という）に共通に適用される利用条件を定めるものです。
この利用規約（以下「本規約」とします）は、Ke1G（以下、乙とします）が運営するウェブサイト「SAP × AI Insights Blog（https://ke1gtech.com/）」（以下「当サイト」とします）で公開している便利ツール・プログラム（以下「本プログラム」という）をダウンロードして利用する者（以下「利用者」という）に共通に適用される利用条件を定めるものです。
この利用規約（以下「本規約」とします）は、Ke1G（以下、乙とします）が運営するウェブサイト「SAP × AI Insights Blog（https://ke1gtech.com/）」（以下「当サイト」とします）で公開している便利ツール・プログラム（以下「本プログラム」という）をダウンロードして利用する者（以下「利用者」という）に共通に適用される利用条件を定めるものです。
この利用規約（以下「本規約」とします）は、Ke1G（以下、乙とします）が運営するウェブサイト「SAP × AI Insights Blog（https://ke1gtech.com/）」（以下「当サイト」とします）で公開している便利ツール・プログラム（以下「本プログラム」という）をダウンロードして利用する者（以下「利用者」という）に共通に適用される利用条件を定めるものです。本プログラムをご使用になる前に、本規約をよくお読み下さい。利用者は本プログラムをダウンロードしたことによって本規約のすべての条件に同意したものとみなされます。本規約の条件に同意いただけない場合は、本プログラムを使用することはできません。
コメント