12,665
回編集
差分
ナビゲーションに移動
検索に移動
getWorkbookRerativeFilename getWorkbook[[R]]erativeFilename = getPath(book.path) & tmp & extents
ReDim [[R]]eDim tmp(UBound(values))
ReDim [[R]]eDim Preserve duplicatedItems(dupIdx)
編集の要約なし
==[[Excel VBA Utility]]==[[Excel VBA]] | {{category [[Category:VBAソース片}}]]
===basUtil===
' Win32 API
Private Declare Function GetPrivateProfileString GetPrivate[[Profile]]String Lib "kernel32" Alias "GetPrivateProfileStringAGetPrivate[[Profile]]StringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString WritePrivate[[Profile]]String Lib "kernel32" Alias "WritePrivateProfileStringAWritePrivate[[Profile]]StringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public Const MAX_INI_LEN As Long = 256
Public Const INI_EXTENT As String = ".ini"
Public Const EXCEL_EXTENT As String = ".xls"
Public Const DIR_SEP DI[[R]]_SEP As String = "\"
'
' 設定を保存する
'
' @param book Excelブック[[Excel]]ブック
' @param strKey 設定キー
' @param strVal 設定値
'
Public Function setAppSetting(ByRef book As [[Excel]].Workbook, _
ByVal strKey As String, _
ByVal strVal As String) As Long
setAppSetting = WritePrivateProfileStringWritePrivate[[Profile]]String( _
APP_NAME, strKey, strVal, getIniFilename(book))
' 設定を取得する
'
' @param book Excelブック[[Excel]]ブック
' @param strKey 設定キー
' @param strDefault 対応する設定値が存在しない場合のデフォルト値
'
Public Function getAppSetting(ByRef book As [[Excel]].Workbook, _
ByVal strKey As String, _
ByVal strDefault As String) As String
Dim result As Long
result = GetPrivateProfileStringGetPrivate[[Profile]]String( _
APP_NAME, strKey, strDefault, strBuf, MAX_INI_LEN, _
getIniFilename(book))
' 初期化ファイル名を取得する
'
' @param book Excelブック[[Excel]]ブック
'
Private Function getIniFilename(ByRef book As [[Excel]].Workbook) As String
getIniFilename = getWorkbookRerativeFilenamegetWorkbook[[R]]erativeFilename(book, INI_EXTENT)
End Function
' EXCEL ファイルのプルパス、拡張子変更文字列を返す
'
' @param book Excelブック[[Excel]]ブック
' @param extents 拡張子
' @return Excelのファイル名の拡張子を変更した文字列[[Excel]]のファイル名の拡張子を変更した文字列
'
Private Function getWorkbookRerativeFilename(ByRef book As [[Excel]].Workbook, extents As String) As String
Dim chk As String
chk = String(Len(EXCEL_EXTENT), " ") & tmp
If Right[[R]]ight$(chk, Len(EXCEL_EXTENT)) = EXCEL_EXTENT Then
tmp = Left$(tmp, Len(tmp) - Len(EXCEL_EXTENT))
End If
End Function
End If
If Right[[R]]ight$(result, 1) <> DIR_SEP DI[[R]]_SEP Then result = result & DIR_SEPDI[[R]]_SEP
End If
getPath = result
'
' ファイルを選択する
' fileFilter eg-"Microsoft Excelブック[[Excel]]ブック,*.xls,テキストファイル,*.txt"
'
Public Function chooseFile(Optional fileFilter As String, _
' @return 区切文字で区切られたテキスト
'
Public Function arrayToSeparetedValueText(ByRef By[[R]]ef fields() As String, separator As String) As String
Dim ret As String
' @param values ソート対象の文字列配列
'
Public Sub bubbleSort(ByRef By[[R]]ef values() As String)
Dim tmp As String
' @return 重複がある場合に true を返す
'
Public Function duplicatedCheck(ByRef By[[R]]ef values() As String, ByRef By[[R]]ef duplicatedItems() As String) As Boolean
Dim result As Boolean
Dim i As Integer
dupIdx = 0
For i = LBound(values) To UBound(values)
tmp(i) = values(i)
If i > LBound(tmp) Then
If curVal = tmp(i) Then
duplicatedItems(dupIdx) = curVal
dupIdx = dupIdx + 1
© 2006 矢木浩人
