忍者ブログ
  • 2025.05《
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 》 2025.07
[PR]
×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

2025/06/20 04:17 |
Other
Excelマクロのモジュールをそのまま貼り付け。
(会社とか家とか出先とかで見るため)
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に!
貼り付け後、「■Sub 」を「Sub 」に置き換えよう!
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'
'その他マクロ

■Sub ファイルの起動時にマクロを実行する()

'auto_open() ←マクロ名

MsgBox "B5をアクティブにします。   "
Range("B5").Activate '記述はなんでもいい

End Sub

■Sub auto_openをデバッグする()
'シングルステップで実行する場合は[f8]

Workbooks.Open("D:\My Documents\da Vinci出力\ファイル変換v1.xls").RunAutoMacros xlAutoOpen

End Sub

■Sub ファイルを閉じる時にマクロを実行する()

'Sub auto_close()
'Sub Auto_Close() ※どちらでもOK
'※マクロの Closeイベントで閉じる場合、実行されない。
'※マクロの Closeイベントを実行するときは、[ThisWorkbook]のコードウィンドウに記述する。

If vbYes = MsgBox("上書き保存しますか?   ", vbYesNo + vbQuestion, "ファイルを終了") Then
ThisWorkbook.Close True '保存して閉じる
Else
ThisWorkbook.Close False '保存しないで閉じる
End If

'※IF文の分岐内に“End”を入れても、Auto_Closeはキャンセルできないので注意。

End Sub

■Sub 確認ダイアログを非表示()

Application.DisplayAlerts = False '非表示
Application.DisplayAlerts = True '表示

End Sub

■Sub クリップボートを空にする()

Application.CutCopyMode = False

End Sub

■Sub DoEvents関数()

'発生したイベントがオペレーティングシステムによって処理されるように制御を戻します。
'DoEventsは、MS-WindowsがUNIXやLinux等のマルチタスクOSではなく、疑似マルチタスクであるため必要なものです。
'通常マルチタスクOSでは、同時に実行される各種のプログラムに対して処理に必要な時間と順序をOSが配分して
'実行しますが、MS-Windowsではプログラムから処理が戻ってから(今回ではプロシージャが終了してから)、
'次のプログラムやキー入力、マウス入力イベント等を実行します。
'したがって、時間のかかる処理や無限ループなどがあると、他の処理が実行できなくなり、
'極端に全体の反応が遅くなったり、動かなくなったりします。
'#画面が白くなるのは、表示の更新が行われなくなるためです。
'そうなる事を防ぐ為、DoEventsを実行して、他のプログラムやイベント処理を実行させる必要があります。

'【使用例】
Dim i As Variant
For i = 1 To 10
Cells(i, 3).Value = i
DoEvents '←★
Next

End Sub

■Sub DoLoop文()
'Do While 条件式 …条件式がtrueの間だけ処理を実行。
'Do Until 条件式 …条件式がtrueになるまで処理を実行。

'セルA1からシート終端セルまで、文字列"ABC"を探す
Dim i As Long

i = 1
Do While Cells(i, 1) <> "ABC"
If i = Cells.Rows.Count Then
'シート終端に達したら、ループを抜ける
Exit Do
End If
i = i + 1
Loop

End Sub

■Sub ForNext文()
'For文は繰り返しの回数が決まっているとき、
'Do文は繰り返し回数が決まっていないときに使用すると、ソースの意味がわかりやすくなります。
'For Nextで使うカウンタ変数は、アルファベット小文字の「i」「j」「k」を使うのが一般的です。

'セルA1~セルA10 に値を入力する
Dim i As Long
For i = 1 To 10
Cells(i, 1).Value = i
Next

'■増減値を指定
For i = 1 To 10 Step 2
Cells(i, 1).Value = i
Next

'■ループアウト
'Exit Forステートメントを使用すると繰り返しを抜ける事が出来ます。
For i = 1 To 10 Step 2
If myCnt = 5 Then Exit For
Cells(i, 1).Value = i
Next

End Sub

■Sub Sleepで処理を一時中断()

'Timerモジュール参照

End Sub

■Sub IF文の書き方()

Dim a As Variant
a = 10


'ふつうの書き方(処理ごとに改行)
If a = 0 Then
MsgBox "true(処理ごとに改行しています。)"
Else
MsgBox "false(処理ごとに改行しています。)"
End If


'Else文を1行に記述
If a = 0 Then
MsgBox "合ってる(Else文を1行に記述しています。)"
Else: MsgBox "間違ってる(Else文を1行に記述しています。)"
End If


'Else文を1行に記述(エラーになる例)
If a = 0 Then MsgBox "合ってる(Else文を1行に記述しています。)" '真の処理文(Then以下)は次の行にしないと×
Else: MsgBox "間違ってる(Else文を1行に記述しています。)"
End If


'すべて1行で記述(処理がそれぞれ1つの場合。End Ifは記述しない)
If a = 0 Then MsgBox "OK(すべて1行で記述)" Else MsgBox "NG(すべて1行で記述)"

If a = 0 Then MsgBox "OK(すべて1行で記述/Elseの処理なし)" 'Elseの処理がないときはこれでもいいみたい


'If Not文
If Not ActiveSheet.Name Is "Sheet1" Then MsgBox "YES(If Not文)" Else MsgBox "NO" 'If xxx <> xxx ~ だと×なときがあるみたい


'※ ElseIf を含む場合は、ふつうの書き方(処理ごとに改行)のみOK
a = InputBox("数字を入れて")

If a = 1 Then
MsgBox "Yes"
ElseIf a = 2 Then
MsgBox "YesYes"
Else
MsgBox "No!"
End If

End Sub

■Sub メッセージBOXをIF文に利用する()

'MeaBoxの「メッセージBOXをIF文に利用する」参照

End Sub

■Sub CASE選択1()

Select Case Range("A1").Value
Case Is < 3 '演算した結果を比較演算子で指定(セルA1が"3未満")
MsgBox "A"
Case 5 '値を指定(Is = 5 でもOK)
MsgBox "B"
Case 7 To 9 '演算した結果を範囲で指定(セルA1が7~9)
MsgBox "C"
Case Else '上記に当てはまらない場合(Else)
MsgBox "該当なし"
End Select

End Sub

■Sub CASE選択2()
'Select Caseステートメント

ans% = MsgBox("確認しちください♪", vbYesNoCancel)

Select Case ans%
Case vbYes
GoTo step1 '処理分岐(Yesなら行ラベル名「step1」を実行する)
Case vbNo
GoTo step2
Case vbCancel 'Case Elseでもよい
GoTo step3
End Select

step1: 'これを「ラベル(行ラベル)」と呼ぶらしい
MsgBox "step1を実行します"

'その2
Select Case 変数
Case 値1
変数 = 値1の場合の処理
Case 値2
変数 = 値2の場合の処理
Case Else
変数 = 値1、変数 = 値2を満たさなかった場合の処理
End Select

End Sub

■Sub CASE選択3_ファイル取込()

Dim ans As Variant

ans = MsgBox(f_type & "ファイルの取り込みを開始します。   ", vbOKCancel + vbQuestion, "CSVファイルの取り込み")
Select Case ans
Case vbYes
Call CSVファイルを読み込む 'CSVファイル(集団型)を開く
Case vbNo
個別型を開く2: 'ラベル
f_type = "個別型"
If vbYes = MsgBox(f_type & "ファイルの取り込みを開始します。   ", vbYesNo + vbQuestion, "CSVファイルの取り込み") Then
Call CSVファイルを読み込む 'CSVファイル(個別型)を開く
MsgBox "取込完了   ", vbInformation
Exit Sub
Else
MsgBox "終了します。" & vbNewLine & f_type & "ファイルは取り込まれていません。   ", vbInformation, "取込終了"
Exit Sub
End If

Case vbCancel
Exit Sub
End Select

GoTo 個別型を開く2

End Sub

■Sub 処理分岐_GoToステートメント()
'上記「CASE選択」も参照

MsgBox ("Gotoステートメントのテスト1")

GoTo Label1

MsgBox ("Gotoステートメントのテスト2") '→実行されない

Label1: 'これを「ラベル(行ラベル)」と呼ぶらしい
MsgBox ("Gotoステートメントのテスト3")


End Sub

■Sub 処理分岐_Callステートメント()
'プロシージャの呼び出し

Call 枠線の表示切替 '「Sub 枠線の表示切替()」を呼び出す

'※単に呼び出したいプロシージャ名を記述するだけで呼び出すこともできる
枠線の表示切替

'Gotoは、同じプロシージャ内。「処理分岐_GOTO」参照↑

End Sub

■Sub 文字コード変換()

Dim st As ADODB.Stream
Dim rowNo As Integer

On Error GoTo Err

'ADODB.Stream生成
Set st = New ADODB.Stream

'Textモード
st.Type = adTypeText

'文字コード(Shift_JIS, Unicodeなど)
st.Charset = "UTF-8"

'Streamのオープン
st.Open

'ファイル読み込み
st.LoadFromFile ("C:\test2.csv")

rowNo = 1
'ファイルの終りまでループ
Do While Not (st.EOS)
'1行読み込み(readText(adReadAll):すべて読み込み)
Worksheets("Sheet1").Cells(rowNo, 1).Value = st.ReadText(adReadLine)
rowNo = rowNo + 1
Loop

'クローズ
st.Close
Set st = Nothing

Exit Sub

Err:
Set st = Nothing

'エラー内容
MsgBox (Err.Description)

End Sub

■Sub Debug_()
'変数の値をイミディエイトに表示

Debug.Print f_path

End Sub

■Sub Excelのバージョンを取得()

MsgBox Application.Version

'バージョン 戻り値(文字列型)
'2010 14.0
'2007 12.0
'2003 11.0
'2002 10.0
'2000 9.0
'97 8.0
'95 7.0
'5.0 5.0

End Sub

■Sub ファイルフォーマットを取得()

MsgBox ActiveWorkbook.FileFormat

'戻り値は、ヘルプ→Microsoft Visual Basic for Applications ヘルプ→「XlFileFormat 列挙」で検索、参照

End Sub
PR
2015/04/14 21:44 | Excelマクロ(VBA) | コメント(0)
<<MsgBox | ホーム | OtherApp>>
コメント
コメントの投稿















前ページ | ホーム | 次ページ