トップ 一覧 ping 検索 ヘルプ RSS ログイン

Excel VBA GUIDを生成するの変更点

  • 追加された行はこのように表示されます。
  • 削除された行はこのように表示されます。
!!!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