カテゴリー: VBA関連

①API宣言
Declare PtrSafe Function FindWindow Lib “user32” Alias “FindWindowA” ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

‘ 編集部分を取得するため
Declare PtrSafe Function FindWindowEx Lib “user32” Alias “FindWindowExA” ( _
ByVal hwndParent As LongPtr, _
ByVal hwndChildAfter As LongPtr, _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

‘ 編集部分に文字列を送るため
Declare PtrSafe Function SendMessage Lib “user32” Alias “SendMessageA” ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As LongPtr

Sub sample()

‘ファイル選択ダイアログボックスのハンドルを捕まえる
Dim handle As Long
handle = FindWindow(“#32770”, “開く”)

‘捕まえたハンドル（handle）から入力ボックス（ファイル名が入るところ）のハンドルを捕まえる
Dim hInputBox As Long
hInputBox = FindWindowEx(handle, 0&, “ComboBoxEx32”, “”)
hInputBox = FindWindowEx(hInputBox, 0&, “ComboBox”, “”)
hInputBox = FindWindowEx(hInputBox, 0&, “Edit”, “”)
Call SendMessage(hInputBox, &HC, 0, ByVal “*ファイルPATH“)

‘捕まえたハンドル（handle）から”開く”ボタンのハンドルを取得する
Dim hButton As Long
hButton = FindWindowEx(handle, 0&, “Button”, “開く(&O)”) ‘開くボタン
Call SendMessage(hButton, &HF5, 0, 0&) ‘ボタンをクリックする

End Sub

こちらのブログから転記させて頂きました。とても助かりました

【EXCEL VBA | ノート】Windowハンドルを取得して、ファイル選択ダイアログボックスを操作する

Sub utf8import()
    Dim ws As Worksheet
    Dim qtbl As QueryTable
    Dim getfilepath As String
    
    Set ws = ActiveSheet
    
    getfilepath = Application.GetOpenFilename("ブック, *.txt") ' .txtファイルを選ぶ
    If getfilepath <> "False" Then
    Else
        MsgBox "キャンセル"
        End
    End If
    
    Set qtbl = ws.QueryTables.Add(Connection:="TEXT;" & getfilepath, Destination:=ws.Range("A1")) ' CSV を開く
    With qtbl
        .TextFilePlatform = 65001        ' 文字コード UTF-8
        .TextFileTabDelimiter = True     ' タブ区切り
        .RefreshStyle = xlOverwriteCells ' 上書き
        .Refresh                         ' 表示する
        .Delete                          ' CSV接続 解除
    End With

End Sub

UTF-8　LF改行の場合のタブ区切り

Sub Sample2()
Dim buf As String, Target As String, i As Long
Dim tmp1 As Variant, tmp2 As Variant, j As Long
Target = “C:\商品レポート.txt”
With CreateObject(“ADODB.Stream”)
.Charset = “UTF-8”
.Open
.LoadFromFile Target
buf = .ReadText
.Close
tmp1 = Split(buf, vbLf) ‘LFはvbLf　CR + LFはvbCrLf
For i = 0 To UBound(tmp1)
tmp2 = Split(tmp1(i), vbTab) ‘タブはvbTab
j = j + 1
Range(Cells(j, 1), Cells(j, 34)) = tmp2
Next i
End With
End Sub

カンマ区切り

Sub utf8importcsv()
    Dim ws As Worksheet
    Dim qtbl As QueryTable
    Dim getfilepath As String
    
    Set ws = ActiveSheet
    
    getfilepath = Application.GetOpenFilename("ブック, *.csv") ' .csvファイルを選ぶ
    If getfilepath <> "False" Then
    Else
        MsgBox "キャンセル"
        End
    End If
    
    Set qtbl = ws.QueryTables.Add(Connection:="TEXT;" & getfilepath, Destination:=ws.Range("A1")) ' CSV を開く
    With qtbl
        .TextFilePlatform = 65001        ' 文字コード UTF-8
        .TextFileCommaDelimiter = True   ' カンマ区切り
        .RefreshStyle = xlOverwriteCells ' 上書き
        .Refresh                         ' 表示する
        .Delete                          ' CSV接続 解除
    End With

End Sub

Sub try()
Dim r As Range
Dim rr As Range

Set rr = Range(“A1”)

For Each r In Selection
rr.Value = r.Value
Set rr = rr.Offset(1)
Next

Set rr = Nothing
End Sub

少し変更

For Each r In Selection ‘選択範囲を順に実行
k = r.Row

‘ Cells(i, 2).Value = r.Value
Cells(i, 2).Value = Cells(k, 2).Value
i = i + 1
Next

Function プロシージャ名(ByVal 引数名1 As データ型, ByVal 引数名2 As データ型, ・・・) As 戻り値のデータ型
プロシージャ名 = 戻り値
End Function

Sub macro3()
Dim str As String
str = func3(2, 3)
MsgBox str, vbInformation
End Sub

Function func3(ByVal num1 As Integer, ByVal num2 As Integer) As String
Dim mul As Integer
mul = num1 * num2
func3 = CStr(num1) & ” * ” & CStr(num2) & ” = ” & CStr(mul)
End Function

文字の置き換え関数

InStr+引数2つ	前から検索する
InStr+引数3つ	前から検索する+開始位置を指定
InstrRev+引数2つ	後から検索する
InstrRev+引数3つ	後から検索する+開始位置を指定

InStr(文字列, 検索する文字列)

Function imgdel() ‘画像のみ一括選択する
Dim chkBox As Excel.CheckBox
Dim objShape As Object
Dim arr() As String
ReDim Preserve arr(0)
Dim sh01 As Worksheet
Set sh01 = Worksheets(“キーワード一覧”)

'選択シートに存在するオブジェクトを取得します。
For Each objShape In sh01.Shapes

    arr(UBound(arr)) = objShape.Name

    'オブジェクトのタイプが画像であるか判定します。
    If objShape.Type = 11 Then　’リンク画像 11

        '画像オブジェクトの名前を配列に追加します。
        arr(UBound(arr)) = objShape.Name

        '値を保持したまま配列を最大インデックスを追加します。
        ReDim Preserve arr(UBound(arr) + 1)

    End If

Next

'空の値を削除します。
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)

'画像オブジェクトを選択します。
sh01.Shapes.Range(arr).Select

'選択オブジェクトを削除します。
Selection.Delete
End If

End Function

選択する種別を変更

msoAutoShape 図形／オートシェイプ 1
msoCallout 吹き出し 2
msoChart グラフ 3
msoComment コメント 4
msoGroup グループ化された図形 6
msoLinkedPicture リンク画像 11
msoPicture 画像 13
msoTextBox テキストボックス 17
msoTable 表 19