12,666
回編集
差分
ナビゲーションに移動
検索に移動
ページの作成:「==Excel VBA GUIDを生成する== ======== Public Sub GetGUID() Dim typelib As Object Dim guid As String Set typelib = CreateObject("Scriptle…」
==Excel VBA GUIDを生成する==
========
Public Sub GetGUID()
Dim typelib As Object
Dim guid As String
Set typelib = CreateObject("Scriptlet.TypeLib")
guid = Mid$(typelib.guid, 2, 36)
ActiveCell.Value = guid
End Sub
====上記でエラーとなる場合====
Private Const SEP As String = ","
Private Type GUID_TYPE
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr
Function CreateGuidString()
Dim guid As GUID_TYPE
Dim strGuid As String
Dim retValue As LongPtr
Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}
retValue = CoCreateGuid(guid)
If retValue = 0 Then
strGuid = String$(guidLength, vbNullChar)
retValue = StringFromGUID2(guid, StrPtr(strGuid), guidLength)
If retValue = guidLength Then
' valid GUID as a string
CreateGuidString = strGuid
End If
End If
End Function
Public Sub GetGUID()
Dim strGuid As String
strGuid = CreateGuidString()
strGuid = Replace(Replace(strGuid, "{", ""), "}", "")
ActiveCell.Value = strGuid
End Sub
========
Public Sub GetGUID()
Dim typelib As Object
Dim guid As String
Set typelib = CreateObject("Scriptlet.TypeLib")
guid = Mid$(typelib.guid, 2, 36)
ActiveCell.Value = guid
End Sub
====上記でエラーとなる場合====
Private Const SEP As String = ","
Private Type GUID_TYPE
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr
Function CreateGuidString()
Dim guid As GUID_TYPE
Dim strGuid As String
Dim retValue As LongPtr
Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}
retValue = CoCreateGuid(guid)
If retValue = 0 Then
strGuid = String$(guidLength, vbNullChar)
retValue = StringFromGUID2(guid, StrPtr(strGuid), guidLength)
If retValue = guidLength Then
' valid GUID as a string
CreateGuidString = strGuid
End If
End If
End Function
Public Sub GetGUID()
Dim strGuid As String
strGuid = CreateGuidString()
strGuid = Replace(Replace(strGuid, "{", ""), "}", "")
ActiveCell.Value = strGuid
End Sub
© 2006 矢木浩人
