catsの出来ることからこつこつと…(VB・VBA)

[0回]

VBAなどで、乱数を発生させたい場合は下記の通りになります。
最大数値と最小数値に任意の数値を入れて下さい。


Dim RN As Long
Randomize
RN = fix( ([最大数値] * Rnd) + [最小数値] )
Debug.Print RN
 

[0回]

VBAで、ひらがなをカタカナに変換したり、半角にしたり、大文字にしたりするVBAです。


Function KANA()

Dim CN As ADODB.Connection
Dim RSA As ADODB.Recordset
Dim SQL As String

Set CN = CurrentProject.Connection
Set RSA = New ADODB.Recordset

SQL = "SELECT [主キー],[カナフィールド] FROM [テーブル名]"

RSA.Open SQL, CN

Do Until RSA.EOF
 'vbUpperCase　　1　　文字列を大文字に変換します。
 'vbLowerCase　　2　　文字列を小文字に変換します。
 'vbProperCase　　3　　文字列の各単語の先頭の文字を大文字に変換します。
 'vbWide　　4　　文字列内の半角文字 (１バイト) を全角文字 (２ バイト) に変換します。
 'vbNarrow　　8　　文字列内の全角文字 (２バイト) を半角文字 (１バイト) に変換します。
 'vbKatakana　　16　　文字列内のひらがなをカタカナに変換します。
 'vbHiragana　　32　　文字列内のカタカナをひらがなに変換します。
 'vbUnicode　　64　　システムの既定のコード ページを使って文字列を Unicode に変換します。
 'vbFromUnicode　　128　　文字列を Unicode からシステムの既定のコード ページに変換します。
    SQL = "UPDATE [テーブル名] SET [カナフィールド]='"
    SQL = SQL & StrConv(RSA![カナフィールド], vbKatakana)
    SQL = SQL & "' WHERE [主キー]=" & RSA![主キー]
   
    CN.Execute SQL

    RSA.MoveNext
Loop

CN.Close
Set CN = Nothing

End Function

[0回]

winだとS-JISですが、Webの世界だと最近UTF-8を使う事が多いcatsです。
ローカルで作ったファイルの文字コードをイチイチUTF-8へ変換するのが面倒なので、一括で変換出来るVBA作りました。


'引数「FN」にファイルのフルパスを入れます。

Function SJIS_to_UTF8(FN As String)

Dim FROM_OBJ As Object
Dim TO_OBJ As Object

Set FROM_OBJ = CreateObject("ADODB.Stream")
With FROM_OBJ
    .Type = 2
    .Charset = "shift-jis"
    .Open
    .LoadFromFile FN
    .Position = 0
End With

Set TO_OBJ = CreateObject("ADODB.Stream")
With TO_OBJ
    .Type = 2
    .Charset = "utf-8"
    .Open
End With

FROM_OBJ.copyto TO_OBJ
TO_OBJ.Position = 0
TO_OBJ.savetofile FN & "_utf.txt", 2

End Function

[27回]

Function MKFile(FN As String)

'引数「FN」：ファイルのフルパス
'ファイルの有無をチェックして、あれば削除し、新規作成する

On Error GoTo ERSKIP

Dim FSO As FileSystemObject
Dim TXTSRM As TextStream

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FileExists(FN) Then
    Call FSO.DeleteFile(FN, True)
End If

Set TXTSRM = FSO.CreateTextFile(FN)
Set FSO = New FileSystemObject

Set FSO = Nothing

ERSKIP:
    If Not TXTSRM Is Nothing Then
        Call TXTSRM.Close
        Set TXTSRM = Nothing
    End If

End Function

[0回]