DLL
AccessibleFromVBA.h
extern "C"
{
#define ACCESSIBLEFROMVBA_API __declspec(dllexport)
ACCESSIBLEFROMVBA_API void WINAPI DoNothing();
ACCESSIBLEFROMVBA_API int WINAPI GetNumberI(int i);
ACCESSIBLEFROMVBA_API void WINAPI GetNumberI2(int* pi);
ACCESSIBLEFROMVBA_API void WINAPI SetString(VARIANT vString);
ACCESSIBLEFROMVBA_API void WINAPI SetStringS(const BSTR sString);
ACCESSIBLEFROMVBA_API void WINAPI GetStringByParam(VARIANT* pvString);
ACCESSIBLEFROMVBA_API void WINAPI GetStringByParamS(BSTR* pbstr);
ACCESSIBLEFROMVBA_API VARIANT WINAPI GetStringByRetVal();
ACCESSIBLEFROMVBA_API BSTR WINAPI GetStringByRetValS();
ACCESSIBLEFROMVBA_API void WINAPI SetArrayGE(const LPSAFEARRAY* ppsa);
ACCESSIBLEFROMVBA_API void WINAPI SetArrayAD(const LPSAFEARRAY* ppsa);
ACCESSIBLEFROMVBA_API void WINAPI GetArrayPE(LPSAFEARRAY* ppsa);
ACCESSIBLEFROMVBA_API void WINAPI GetArrayAD(LPSAFEARRAY* ppsa);
}
AccessibleFromVBA.cpp
追加部分のみ
プロトタイプ宣言
std::wstring convMbc2Wstr(const char* lpcszSrc);
std::wstring convMbcBstr2Wstr(const BSTR& bstr);
DLLに配列を渡す処理
- GE：SafeArrayGetElementを使用して読み込む処理
- AD：SafeArrayAccessDataで取得したポインタを使用して読み込む処理
ACCESSIBLEFROMVBA_API void WINAPI SetArrayGE(const LPSAFEARRAY* ppsa)
{
VARTYPE vt;
HRESULT hResult = SafeArrayGetVartype(*ppsa, &vt);
if (FAILED(hResult))
{
return;
}
UINT uiDims = SafeArrayGetDim(*ppsa);
std::wstringstream ss;
for (UINT i = 1; i <= uiDims; ++i)
{
LONG lLBound, lUBound;
hResult = SafeArrayGetLBound(*ppsa, i, &lLBound);
hResult = SafeArrayGetUBound(*ppsa, i, &lUBound);
ss << i << L"次元\n"
<< L" LBound：" << lLBound << L"\n"
<< L" UBound：" << lUBound << L"\n";
}
if (vt == VT_I4)
{
ss << L"データ型：Long\n";
if (uiDims == 2)
{
LONG lIndex[2];
LONG lLBound[2];
LONG lUBound[2];
hResult = SafeArrayGetLBound(*ppsa, 1, &lLBound[0]);
hResult = SafeArrayGetUBound(*ppsa, 1, &lUBound[0]);
for (LONG i = lLBound[0]; i <= lUBound[0]; ++i)
{
hResult = SafeArrayGetLBound(*ppsa, 2, &lLBound[1]);
hResult = SafeArrayGetUBound(*ppsa, 2, &lUBound[1]);
lIndex[0] = i;
for (LONG j = lLBound[1]; j <= lUBound[1]; ++j)
{
lIndex[1] = j;
int iValue;
hResult = SafeArrayGetElement(*ppsa, lIndex, &iValue);
ss << iValue << L"\n";
}
}
}
}
else if (vt == VT_BSTR)
{
ss << L"データ型：String\n";
if (uiDims == 1)
{
LONG lLBound;
LONG lUBound;
hResult = SafeArrayGetLBound(*ppsa, 1, &lLBound);
hResult = SafeArrayGetUBound(*ppsa, 1, &lUBound);
for (LONG lIndex = lLBound; lIndex <= lUBound; ++lIndex)
{
BSTR bstr;
SafeArrayGetElement(*ppsa, &lIndex, &bstr);
ss << convMbcBstr2Wstr(bstr) << L"\n";
SysFreeString(bstr);
}
}
}
else if (vt == VT_VARIANT)
{
ss << L"データ型：Variant\n";
if (uiDims == 1)
{
LONG lLBound;
LONG lUBound;
hResult = SafeArrayGetLBound(*ppsa, 1, &lLBound);
hResult = SafeArrayGetUBound(*ppsa, 1, &lUBound);
for (LONG lIndex = lLBound; lIndex <= lUBound; ++lIndex)
{
VARIANT vValue;
VariantInit(&vValue);
hResult = SafeArrayGetElement(*ppsa, &lIndex, &vValue);
switch (vValue.vt)
{
case VT_I4:
ss << std::to_wstring(vValue.intVal) << L"\n";
break;
case VT_R8:
ss << std::to_wstring(vValue.dblVal) << L"\n";
break;
case VT_BSTR:
ss << vValue.bstrVal << L"\n";
break;
case VT_BSTR | VT_BYREF:
ss << vValue.pbstrVal << L"\n";
break;
default:
break;
} ;
VariantClear(&vValue);
}
}
}
else
{
MessageBox(NULL, L"No Data Type matched.", L"SetArrayGE", MB_OK | MB_ICONINFORMATION);
return;
}
MessageBox(NULL, ss.str().c_str(), L"SetArrayGE", MB_OK | MB_ICONINFORMATION);
return;
}
ACCESSIBLEFROMVBA_API void WINAPI SetArrayAD(const LPSAFEARRAY* ppsa)
{
VARTYPE vt;
HRESULT hResult = SafeArrayGetVartype(*ppsa, &vt);
if (FAILED(hResult))
{
return;
}
UINT uiDims = SafeArrayGetDim(*ppsa);
std::wstringstream ss;
for (UINT i = 1; i <= uiDims; ++i)
{
LONG lLBound, lUBound;
hResult = SafeArrayGetLBound(*ppsa, i, &lLBound);
hResult = SafeArrayGetUBound(*ppsa, i, &lUBound);
ss << i << L"次元\n"
<< L" LBound：" << lLBound << L"\n"
<< L" UBound：" << lUBound << L"\n";
}
if (vt == VT_I4)
{
ss << L"データ型：Long\n";
ULONG ulElems(1);
for (ULONG i = 0; i < uiDims; ++i)
{
ulElems *= (*ppsa)->rgsabound[i].cElements;
}
int* piValue(0);
hResult = SafeArrayAccessData(*ppsa, (void**)&piValue);
for (ULONG i = 0; i < ulElems; ++i)
{
ss << L"0x" << std::setfill(L'0') << std::right << std::setw(8) << std::hex << *piValue << L"\n";
++piValue;
}
hResult = SafeArrayUnaccessData(*ppsa);
}
else if (vt == VT_BSTR)
{
ss << L"データ型：String\n";
BSTR* pbstr(0);
hResult = SafeArrayAccessData(*ppsa, (void**)&pbstr);
std::wstring ws = convMbcBstr2Wstr(*pbstr);
for (ULONG i = 0; i < (*ppsa)->rgsabound[0].cElements; ++i)
{
ws = convMbcBstr2Wstr(*pbstr);
ss << ws << L"\n";
++pbstr;
}
hResult = SafeArrayUnaccessData(*ppsa);
}
else if (vt == VT_VARIANT)
{
ss << L"データ型：Variant\n";
VARIANT* pv(0);
hResult = SafeArrayAccessData(*ppsa, (void**)&pv);
for (ULONG i = 0; i < (*ppsa)->rgsabound[0].cElements; ++i)
{
switch (pv->vt)
{
case VT_I4:
ss << std::to_wstring(pv->intVal) << L"\n";
break;
case VT_R8:
ss << std::to_wstring(pv->dblVal) << L"\n";
break;
case VT_BSTR:
ss << convVstr2Wstr(*pv) << L"\n";
break;
default:
break;
}
++pv;
}
hResult = SafeArrayUnaccessData(*ppsa);
}
else
{
MessageBox(NULL, L"No Data Type matched.", L"SetArrayAD", MB_OK | MB_ICONINFORMATION);
return;
}
MessageBox(NULL, ss.str().c_str(), L"SetArrayAD", MB_OK | MB_ICONINFORMATION);
return;
}
DLLで配列を更新して返す処理
- PE：SafeArrayPutElementを使用して書き換える処理
- AD：SafeArrayAccessDataで取得したポインタを使用して書き換える処理
ACCESSIBLEFROMVBA_API void WINAPI GetArrayPE(LPSAFEARRAY* ppsa)
{
VARTYPE vt;
HRESULT hResult = SafeArrayGetVartype(*ppsa, &vt);
if (FAILED(hResult))
{
return;
}
UINT uiDims = SafeArrayGetDim(*ppsa);
LONG* plLBound = new LONG[uiDims];
LONG* plUBound = new LONG[uiDims];
for (UINT i = 0; i < uiDims; ++i)
{
SafeArrayGetLBound(*ppsa, i + 1, &plLBound[i]);
SafeArrayGetUBound(*ppsa, i + 1, &plUBound[i]);
}
if (vt == VT_I4)
{
if (uiDims == 2)
{
LONG* plIndex = new LONG[uiDims];
for (LONG i = plLBound[0]; i <= plUBound[0]; ++i)
{
plIndex[0] = i;
for (LONG j = plLBound[1]; j <= plUBound[1]; ++j)
{
plIndex[1] = j;
long lValue;
SafeArrayGetElement(*ppsa, plIndex, &lValue);
lValue *= 2;
SafeArrayPutElement(*ppsa, plIndex, &lValue);
}
}
}
}
else if (vt == VT_R8)
{
if (uiDims == 1)
{
LONG lIndex;
for (LONG i = plLBound[0]; i <= plUBound[0]; ++i)
{
lIndex = i;
double dValue;
SafeArrayGetElement(*ppsa, &lIndex, &dValue);
dValue /= 2.0;
SafeArrayPutElement(*ppsa, &lIndex, &dValue);
}
}
}
else if (vt == VT_VARIANT)
{
if (uiDims == 1)
{
LONG lIndex;
for (LONG i = plLBound[0]; i <= plUBound[0]; ++i)
{
VARIANT vOrg;
VariantInit(&vOrg);
lIndex = i;
SafeArrayGetElement(*ppsa, &lIndex, &vOrg);
VARIANT vOut;
VariantInit(&vOut);
if (vOrg.vt == VT_EMPTY)
{
vOut.vt = VT_BSTR;
}
else
{
vOut.vt = vOrg.vt;
}
switch (vOrg.vt)
{
case VT_I4:
vOut.intVal = vOrg.intVal * 2;
SafeArrayPutElement(*ppsa, &lIndex, &vOut);
break;
case VT_R8:
vOut.dblVal = vOrg.dblVal / 2.0;
SafeArrayPutElement(*ppsa, &lIndex, &vOut);
break;
case VT_BSTR:
{
std::wstring ws = L"GetArrayPE";
ws += std::to_wstring(lIndex);
SysReAllocString(&vOut.bstrVal, ws.c_str());
SafeArrayPutElement(*ppsa, &lIndex, &vOut);
SysFreeString(vOut.bstrVal);
}
break;
default:
break;
}
VariantClear(&vOrg);
VariantClear(&vOut);
}
}
}
else if (vt == VT_BSTR)
{
if (uiDims == 1)
{
LONG lIndex;
for (LONG i = plLBound[0]; i <= plUBound[0]; ++i)
{
lIndex = i;
std::string sReturn = "GetArrayPE:";
sReturn += std::to_string(i + 1);
size_t lenByte = sReturn.length();
BSTR bstr = SysAllocStringByteLen(sReturn.c_str(), lenByte);
SafeArrayPutElement(*ppsa, &lIndex, bstr);
SysFreeString(bstr);
}
}
}
delete[] plLBound;
delete[] plUBound;
return;
}
ACCESSIBLEFROMVBA_API void WINAPI GetArrayAD(LPSAFEARRAY* ppsa)
{
VARTYPE vt;
HRESULT hResult = SafeArrayGetVartype(*ppsa, &vt);
if (FAILED(hResult))
{
return;
}
UINT uiDims = SafeArrayGetDim(*ppsa);
ULONG ulElems(1);
for (ULONG i = 0; i < uiDims; ++i)
{
ulElems *= (*ppsa)->rgsabound[i].cElements;
}
if (vt == VT_I4)
{
int* piValue;
SafeArrayAccessData(*ppsa, (void**)&piValue);
for (ULONG i = 0; i < ulElems; ++i)
{
*piValue *= 3;
++piValue;
}
SafeArrayUnaccessData(*ppsa);
}
else if (vt == VT_BSTR)
{
BSTR* pbstr;
SafeArrayAccessData(*ppsa, (void**)&pbstr);
for (ULONG i = 0; i < ulElems; ++i)
{
std::string ws("GetArrayAD");
ws += std::to_string(i);
UINT lenByte = ws.length();
SysFreeString(*pbstr);
*pbstr = SysAllocStringByteLen(ws.c_str(), lenByte);
++pbstr;
}
SafeArrayUnaccessData(*ppsa);
}
else if (vt == VT_VARIANT)
{
VARIANT* pv;
SafeArrayAccessData(*ppsa, (void**)&pv);
for (ULONG i = 0; i < ulElems; ++i)
{
switch (pv->vt)
{
case VT_I4:
pv->intVal *= 4;
break;
case VT_EMPTY:
{
std::wstring ws(L"GetArrayAD_EMPTY");
ws += std::to_wstring(i);
pv->vt = VT_BSTR;
pv->bstrVal = SysAllocString(ws.c_str());
}
break;
case VT_BSTR:
{
std::wstring ws(L"GetArrayAD_BSTR");
ws += std::to_wstring(i);
SysReAllocString(&(pv->bstrVal), ws.c_str());
}
break;
default:
break;
}
++pv;
}
SafeArrayUnaccessData(*ppsa);
}
return;
}
文字列変換処理
std::wstring convMbc2Wstr(const char* lpcszSrc)
{
if (!lpcszSrc)
{
return std::wstring(L"");
}
int iNeedBufferElems = MultiByteToWideChar(CP_ACP, 0, lpcszSrc, -1, nullptr, 0);
wchar_t* pwsz = new wchar_t[iNeedBufferElems];
int iResult = MultiByteToWideChar(CP_ACP, 0, lpcszSrc, -1, pwsz, iNeedBufferElems);
std::wstring ws(pwsz);
delete[] pwsz;
return ws;
}
std::wstring convMbcBstr2Wstr(const BSTR& bstr)
{
return convMbc2Wstr((const char*)bstr);
}
AccessibleFromVBA.def
LIBRARY AccessibleFromVba
EXPORTS
DoNothing
GetNumberI
GetNumberI2
SetString
SetStringS
GetStringByParam
GetStringByParamS
GetStringByRetVal
GetStringByRetValS
SetArrayGE
SetArrayAD
GetArrayPE
GetArrayAD
Private Declare Sub getArrayPEL Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "GetArrayPE" (ByRef lArray() As Long)
Private Declare Sub getArrayPES Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "GetArrayPE" (ByRef sArray() As String)
Private Declare Sub getArrayPEV Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "GetArrayPE" (ByRef vArray() As Variant)
Private Declare Sub getArrayADL Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "GetArrayAD" (ByRef lArray() As Long)
Private Declare Sub getArrayADS Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "GetArrayAD" (ByRef sArray() As String)
Private Declare Sub getArrayADV Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "GetArrayAD" (ByRef vArray() As Variant)
Private Declare Sub setArrayGEL Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayGE" (ByRef lArray() As Long)
Private Declare Sub setArrayGES Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayGE" (ByRef sArray() As String)
Private Declare Sub setArrayGED Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayGE" (ByRef dArray() As Double)
Private Declare Sub setArrayGEV Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayGE" (ByRef vArray() As Variant)
Private Declare Sub setArrayADL Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayAD" (ByRef lArray() As Long)
Private Declare Sub setArrayADS Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayAD" (ByRef sArray() As String)
Private Declare Sub setArrayADD Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayAD" (ByRef dArray() As Double)
Private Declare Sub setArrayADV Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\AccessibleFromVBA\Debug\AccessibleFromVBA.dll" Alias "SetArrayAD" (ByRef vArray() As Variant)
Public Sub getArrayADTest()
Dim lArray(2 To 5, 3 To 4) As Long
Dim sArray(2 To 6) As String
Dim vArray(3) As Variant
Dim i As Long
Dim j As Long
For i = LBound(lArray, 1) To UBound(lArray, 1)
For j = LBound(lArray, 2) To UBound(lArray, 2)
lArray(i, j) = i * &H10 + j
Debug.Print i, j, "0x" & Hex(lArray(i, j))
Next j
Next i
Debug.Print ""
Call getArrayADL(lArray)
For i = LBound(lArray, 1) To UBound(lArray, 1)
For j = LBound(lArray, 2) To UBound(lArray, 2)
Debug.Print i, j, "0x" & Hex(lArray(i, j))
Next j
Next i
Debug.Print ""
Call getArrayADS(sArray)
For i = LBound(sArray) To UBound(sArray)
Debug.Print sArray(i)
Next i
Debug.Print ""
vArray(0) = ""
vArray(1) = 1&
Call getArrayADV(vArray)
For i = LBound(vArray) To UBound(vArray)
Debug.Print vArray(i)
Next i
End Sub
Public Sub getArrayPETest()
Dim lArray(2 To 5, 3 To 4) As Long
Dim sArray(4) As String
Dim vArray(3) As Variant
Dim i As Long
Dim j As Long
For i = LBound(lArray, 1) To UBound(lArray, 1)
For j = LBound(lArray, 2) To UBound(lArray, 2)
lArray(i, j) = i * 100 + j
Next j
Next i
Call getArrayPEL(lArray)
For i = LBound(lArray, 1) To UBound(lArray, 1)
For j = LBound(lArray, 2) To UBound(lArray, 2)
Debug.Print i, j, lArray(i, j)
Next j
Next i
Call getArrayPEV(vArray)
For i = LBound(vArray) To UBound(vArray)
Debug.Print vArray(i)
Next i
Call getArrayPES(sArray)
For i = LBound(sArray) To UBound(sArray)
Debug.Print sArray(i)
Next i
End Sub
Public Sub setArrayTest()
Dim lArray(3 To 8, 1 To 3) As Long
Dim sArray(2 To 5) As String
Dim dArray(4 To 5) As Double
Dim vArray(5 To 8) As Variant
Dim i As Long
Dim j As Long
For i = LBound(lArray, 1) To UBound(lArray, 1)
For j = LBound(lArray, 2) To UBound(lArray, 2)
lArray(i, j) = i * &H1000 + j * &H10
Next j
Next i
For i = LBound(sArray) To UBound(sArray)
sArray(i) = String(i, CStr(i))
Next i
For i = LBound(dArray) To UBound(dArray)
If i <> 0 Then
dArray(i) = 100 / i
Else
dArray(i) = -1
End If
Next i
vArray(8) = 0.2
vArray(6) = &H1000&
vArray(7) = "VariantArray"
vArray(5) = 16
Call setArrayGEV(vArray)
Call setArrayGED(dArray)
Call setArrayGES(sArray)
Call setArrayGEL(lArray)
Call setArrayADV(vArray)
Call setArrayADD(dArray)
Call setArrayADS(sArray)
Call setArrayADL(lArray)
End Sub
