#author("2023-02-10T14:55:18+09:00","default:irrp","irrp")
→Office関連メモ
→Excel関連
→C＃によるExcel制御
→Visual Basic(.NET以前)
#contents
* サブトピック [#zd8f2c00]
-ExcelのVBAで図形／シェイプの処理
*一般 [#bbc20b28]
-[[【VSCode】XVBAを使ってExcel VBA開発 | とあるエンジニアの備忘録>https://rent-web.jp/post-89/]] 2022
-[[Excel VBAでもう頑張らない | フューチャー技術ブログ>https://future-architect.github.io/articles/20230209a/]] 2023.2
-VarTypeで8204などが返ってくるとき
-- 配列を指定した場合は、配列(8192)+型番号の値が返ります。8204ならVariant(12)の配列
--http://www.openreference.org/articles/view/460
-[[VBAの「ソースコードをロック」ではソースコードをロックできない - Qiita>https://qiita.com/kn1cht/items/e97f00fdcf2e7d456cfa]] 2022.7
-[[VBA100本ノック：マクロVBAの特訓｜エクセルの神髄>https://excel-ubara.com/vba100/]] 2021.3
-[[エクセルアドインとは>http://hp.vector.co.jp/authors/VA029807/jim_carry-xla-exp.htm]]
-[[エクセルＶＢＡ・マクロ勉強参考サイトまとめ>http://matome.naver.jp/odai/2132773983649074301]]
-[[コントロールの誤操作でマクロが作成される>http://pc.nikkeibp.co.jp/article/column/20091109/1020285/?P=1]]
-[[VB & VBAプログラミング>http://www.ops.dti.ne.jp/~allergy/vb/vbvba.html]]
-[[すぐに役立つVBAマクロ集>http://www.happy500z.com/]]
--[[印刷（基本型）>http://www.geocities.jp/happy_ngi/YNxv211.html]]
-[[ExcelRelaxTools Addin>http://software.opensquare.net/relaxtools/]] 2014.1.29
--5年間(2009年〜)にわたって作成したマクロを汎用的、体系的にまとめたものです。
*Tips [#z68b5d4d]
** 添付ファイルをつけてメール [#p7c0a085]
-[[EXCEL VBAでメール一括配信！添付ファイルも付けられるよ その２ - あきらちんの技術メモ>https://www.akiratin.com/excel-vba%E3%81%A7%E3%83%A1%E3%83%BC%E3%83%AB%E4%B8%80%E6%8B%AC%E9%85%8D%E4%BF%A1%EF%BC%81%E6%B7%BB%E4%BB%98%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%82%E4%BB%98%E3%81%91%E3%82%89%E3%82%8C%E3%82%8B/]] 2020
** 画面をキャプチャする [#d6d9263d]
-[[Excel VBA を学ぶなら moug モーグ | 即効テクニック | 画面をキャプチャする>https://www.moug.net/tech/exvba/0150121.html]] 2015
** Googleマップ表示 [#z16f89c2]
-[[ゼロからはじめるExcel VBA＋Webサービス(9) Googleマップを表示してみよう【Google Maps Platform?】 | TECH+>https://news.mynavi.jp/techplus/article/excelvbaweb-9/]]
** CSVやExcelにSQLを実行 [#ud98d858]
-[[【Excel VBA】CSVやExcelファイルにSQLを実行するツール - Qiita>https://qiita.com/taukuma/items/7c65f377e62081800804]]
** マクロの自動実行を抑制 [#e8efef0f]
-[[マクロを実行させずにExcelファイルを開く方法。ブックオープン時に自動的にマクロが実行されなくなるよ | ラブグアバ>https://love-guava.com/open-excel-book-without-running-macro/]] 2019
--ファイルを開く→Shiftを押しながら開く
-[[［Excel VBA］マクロの自動実行を止めるには？ | 日経クロステック（xTECH）>https://xtech.nikkei.com/it/atcl/column/15/090100207/090100052/]] 2015
Application.EnableEvents = False
** 警告抑制 [#c478d36c]
Application.DisplayAlerts = False '警告抑制
** ファイルダイアログ（オープン） [#f5041b4a]
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogOpen)
dlg.InitialFileName = "C:\Windows\"
dlg.Show 'execute だと開く所までやってくれる
Cells(1, 1) = dlg.SelectedItems(1)
-[[[VBA]フォルダ選択ダイアログの使い方・使い分け>https://y-moride.com/vba/dailog-folder-picker.html]] 2021
-Win32APIを直叩きしたい場合
--https://www.moug.net/tech/acvba/0020007.html
Public Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" ( _
pOpenFileName As OPENFILENAME) As Long
'pOpenFileName構造体(ユーザー定義型)の宣言
Type OPENFILENAME
lStructSize As Long '構造体のサイズ
hwndOwner As Long 'ダイアログを所有
' するウインドウハンドル
hInstance As Long 'アプリケーションインスタンス
lpstrFilter As String 'フィルタ
lpstrCustomFilter As Long 'ユーザ定義フィルタ
nMaxCustrFilter As Long 'ユーザ定義フィルタの
' バッファサイズ
nFilterIndex As Long 'デフォルトフィルタのインデックス
lpstrFile As String '選択されたファイル名
nMaxFile As Long 'ファイル名のバッファ
lpstrFileTitle As String '選択されたファイル名のタイトル
nMaxFileTitle As Long 'ファイル名のタイトルのバッファ
lpstrInitialDir As String '初期ディレクトリ
lpstrTitle As String 'ダイアログボックスのタイトル
Flags As Long 'オプション
nFileOffset As Integer 'ファイル名の最後の「\」までの
' オフセット値
nFileExtension As Integer '拡張子までのオフセット値
lpstrDefExt As String 'デフォルトの拡張子
lCustrData As Long 'OSがフック関数に渡すアプリ定義のデータ
lpfnHook As Long 'メッセージを処理するフック関数
' へのポインタ
lpTemplateName As Long
End Type
'定数宣言
'複数のファイルを選択可能に
Public Const OFN_ALLOWMULTISELECT = &H200
'ファイルが存在しなかった場合、新規作成するかどうか表示
Public Const OFN_CREATEPROMPT = &H2000
'エクスプローラ形式のダイアログを使用
Public Const OFN_EXPLORER = &H80000
'存在しないファイル名を入力不可に
Public Const OFN_FILEMUSTEXIST = &H1000
'「読み取り専用」チェックボックスを非表示
Public Const OFN_HIDEREADONLY = &H4
'カレントディレクトリをダイアログのカレントディレクトリにする
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
'ネットワークコンピュータを非表示に
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOVALIDATE = &H100
'ファイルが存在していた場合、上書きを問い合わせる
Public Const OFN_OVERWRITEPROMPT = &H2
'有効なパス名のみを入力可能に
Public Const OFN_PATHMUSTEXIST = &H800
'「読み取り専用」チェックボックスをオンにする
Public Const OFN_READONLY = &H1
'「ヘルプ」ボタンの表示
Public Const OFN_SHOWHELP = &H10
'拡張子がデフォルトの拡張子と異なる場合に設定されるフラグ
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Function GetFileName() As String
Dim pOpenFileName As OPENFILENAME
Dim lngRet As Long
'Accessアプリケーションのハンドルを取得
pOpenFileName.hwndOwner = Application.hWndAccessApp
pOpenFileName.hInstance = 0
'ファイルフィルタの設定
pOpenFileName.lpstrFilter = "全てのファイル (*.*)" & _
String(1, vbNullChar) & _
"*.*" & _
String(2, vbNullChar)
pOpenFileName.lpstrCustomFilter = 0
pOpenFileName.nMaxCustrFilter = 0
pOpenFileName.nFilterIndex = 1
pOpenFileName.lpstrFile = String(511, vbNullChar)
pOpenFileName.nMaxFile = 511
pOpenFileName.lpstrFileTitle = String(512, vbNullChar)
pOpenFileName.nMaxFileTitle = 511
pOpenFileName.lpstrInitialDir = String(1, vbNullChar)
pOpenFileName.lpstrTitle = String(1, vbNullChar)
pOpenFileName.nFileOffset = 0
pOpenFileName.nFileExtension = 0
pOpenFileName.lpstrDefExt = String(1, vbNullChar)
pOpenFileName.lCustrData = 0
pOpenFileName.lpfnHook = 0
pOpenFileName.lpTemplateName = 0
pOpenFileName.lStructSize = Len(pOpenFileName)
'読取専用ファイルを隠す
pOpenFileName.Flags = OFN_HIDEREADONLY _
Or OFN_EXPLORER
lngRet = GetOpenFileName(pOpenFileName)
GetFileName = Left(pOpenFileName.lpstrFile, _
InStr(pOpenFileName.lpstrFile, vbNullChar) - 1)
End Function
** スクレイピング [#l5890357]
-[[時給１０００円の事務員さんのための VBA スクレイピング>https://qiita.com/callmekohei/items/d1e1d4c44e753e4d03de]] 2019.5
**アドイン関連 [#c2cf0356]
-[[VBAをリボンUIに追加する（インストーラー付き）>http://qiita.com/jp7eph/items/c8bf16b644dee82f9bfe]] 2017.7.17
** ExcelにGoogle Maps APIで地図を埋め込み、住所検索、拡大／縮小、地図種類変更 [#af08541d]
-http://www.atmarkit.co.jp/ait/articles/1409/05/news165.html
**開いているファイルの中から名前の左側が引数と合致するファイルを探す [#ye1502e2]
'２つ以上あったらエラー
Function schFile(name As String) As Workbook
Dim cnt As Integer
cnt = 0
Set schFile = Nothing
Dim bk As Workbook
For Each bk In Workbooks
Dim ln As Integer
ln = Len(name)
Debug.Assert (ln > 0)
If StrConv(Left(bk.name, ln), vbUpperCase) = StrConv(name, vbUpperCase) Then
If Not (schFile Is Nothing) Then
MsgBox ("[" & name & "]で始まるファイルが２つ以上あります")
End
End If
Debug.Assert (schFile Is Nothing) '同じ名前で始まるファイルが２つ以上あったらエラーになります
Set schFile = bk
'ここですぐは返らない ２つ以上あったらまずいから
End If
Next
If schFile Is Nothing Then
MsgBox ("[" & name & "]で始まるファイルが見つかりません")
End
End If
End Function
**countifsの数式を元に、同じ条件でフィルタをかける [#db5c2d93]
Sub 数式からフィルター(r As Range)
Dim strSuusiki As String
Dim varPrm As Variant
Dim sh As Worksheet
Dim ac As Worksheet
Dim lngLoop As Long
Dim lngColNo As Long
Dim strJoken As String
Dim rngFil As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sh = Sheets("hoge")
Set ac = r.Worksheet
strSuusiki = r.Formula ''該当セルの数式を取り出す
strSuusiki = Replace(strSuusiki, "=countifs(", "", , , vbTextCompare) '’余分なところを消す
strSuusiki = Replace(strSuusiki, "=countif(", "", , , vbTextCompare) '’余分なところを消す
strSuusiki = Replace(strSuusiki, ")", "") '’余分なところを消す
varPrm = Split(strSuusiki, ",") '’Countifsのパラメータのみを配列に分割する
If Not sh.AutoFilterMode Then ''オートフィルターが付いてない場合
Intersect(sh.UsedRange, sh.Range("10:65535")).AutoFilter '’フィルターをつける
End If
If sh.FilterMode Then '’フィルターがかかっている状態のときはフィルタークリア
sh.ShowAllData
End If
Set rngFil = sh.AutoFilter.Range
For lngLoop = 0 To UBound(varPrm) Step 2
lngColNo = Range(varPrm(lngLoop)).Column ''配列の偶数番目＝検索条件範囲のカラム番号を取得
strJoken = varPrm(lngLoop + 1) ''配列の奇数番目＝検索条件を取得
If InStr(strJoken, """") > 0 Then
strJoken = Replace(strJoken, """", "") '’""がある場合は定数（””は消す）
Else
strJoken = ac.Range(strJoken).Value '’””がない場合はセルへの参照のため参照先の値を取得
End If
rngFil.AutoFilter Field:=lngColNo, Criteria1:=strJoken
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
**ハイパーリンクをクリックしたら上の行（３行目）にあげる [#y32e4897]
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim r As Integer
r = Target.Range.row
If r = 3 Then
Exit Sub
Else
ThisWorkbook.Worksheets(1).Activate
Rows("3:3").Select
Selection.EntireRow.Insert
r = r + 1
Rows(r & ":" & r).Select
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
Range("A" & r).Select
Selection.EntireRow.Delete
End If
End Sub
**セルの値を文字列として取得したい場合 [#p20b2af8]
Cells(i,j).Text
** フィルタ系 [#ma24e96c]
-フィルタをクリアする
ActiveSheet.ShowAllData
-[[行が非表示か判定する>https://www.relief.jp/docs/excel-vba-check-if-row-hidden.html]]
--Range.Hiddenプロパティを見る
-[[オートフィルタ適用後に表示されている行のみを対象に処理を行う>https://www.blackcat.xyz/article.php/ProgFAQ-Xls_ProcessToCellAfterAutoFill]]
** 現在見ているブックの全シートから_YMDHMSという値の入ったセルをすべて探し、その下にあるセルにフォーマットを設定する [#afb8f6b1]
Sub 日付のフォーマット修正()
Debug.Print ("フォーマット修正開始")
Dim bk As Workbook
Dim sht As Worksheet
Set bk = ActiveWorkbook
Dim i As Integer
For i = 1 To bk.Worksheets.Count
Set sht = bk.Worksheets(i)
With sht
.Activate
.Cells(1, 1).Select
Dim r As Range
Set r = Cells.Find(What:="_YMDHMS", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If Not r Is Nothing Then
Dim firstPos As String
firstPos = r.Address
Do
Dim s As String
.Cells(r.row, r.Column).Select
If Trim(.Cells(r.row + 1, r.Column)) <> "" Then
s = .Cells(r.row, r.Column)
Debug.Print (.Name & ":" & r.row & "," & r.Column & "," & s)
.Cells(r.row + 1, r.Column).NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"
.Cells(r.row + 1, r.Column).HorizontalAlignment = xlLeft
Dim rcol As Range
Set rcol = .Columns(r.Column)
rcol.AutoFit
End If
Set r = Cells.FindNext(r)
DoEvents
Loop While (r.Address <> firstPos)
Else
'そもそもない
End If
End With
Next
MsgBox ("OK")
End Sub
**今選択しているシート [#y63ffaf8]
-Application.SelectedSheets を参照する
**「名前」の全消し [#l1b923d9]
-メニューから消していると一回に１つしか消せなくて面倒なので、以下のマクロで
for i = ActiveWorkbook.Names.Count to 1 step -1
ActiveWorkbook.Names(i).Delete
Next
** パスワード付きでブックを保存する [#fb962dce]
ActiveWorkbook.SaveAs Filename:= _
"hoge.xls", FileFormat:= _
xlExcel8, Password:="anestec", WriteResPassword:="", ReadOnlyRecommended _
:=False, CreateBackup:=False
**手っ取り早くExcelシートの一覧を得るには [#mb3fd2e2]
-ALT+F11を押下(VBAエディタが起動)
-CTRL+Gを押下(イミディエイトウインドウが起動)
For Each i In ThisWorkbook.Sheets: debug.print i.name : next i
をタイプしてEnterを押下
**［Esc］キーによるExcel VBAの実行中断を防止する [#jd547d76]
-http://www.atmarkit.co.jp/fwin2k/win2ktips/1437disescexcl/disescexcl.html
Application.EnableCancelKey = xlDisabled
**互換性チェックのダイアログが出るのを抑制 [#r83ca239]
-Office2007で .xlsファイルを保存しようとしたときに出るダイアログを抑制したい場合は、上書き確認の抑制と同じように
Application.DisplayAlerts=False
とする
**Excelで特定の値になったときのアクション [#l5ea8ee5]
-特定のセルに特定の値が入力されたときにマクロを自動的に実行するには？
--http://www.asahi-net.or.jp/~zn3y-ngi/YNxv9c7.html
--WorkSheet_Changeのイベントプロシージャに処理を書けば良い。当然ながらExcelの設定でマクロ実行を許可しておく必要はある（オプションのセキュリティ設定）
**ツリービューコントロール [#d09d738e]
-[[Tree View Controlの組み込み>http://officetanaka.net/excel/vba/treeview/01.htm]]
--「ツール」-「その他のコントロール」から「Microsoft TreeView Control」を選択
-http://www.f3.dion.ne.jp/~element/msaccess/AcTipsFrmUsingTreeView1.html
-http://www.tsware.jp/study/indexv10.htm
-http://www.int21.co.jp/pcdn/vb/noriolib/vbmag/9710/aki/
**VBA コンパイルエラーと実行時エラー [#xb623945]
-http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200_020.html
-Excel2002からある模様
-コンパイルの機能はタイプミスなどのチェックをするためのものと考える
**CSVをUTF-8で保存する [#l005b80d]
-通常のSave機能ではUnicodeまでしか指定できないが、いくつか方法はある
-フリーのモジュールを使用する方法
--http://www.vector.co.jp/soft/winnt/prog/se320375.html
-ADODB.Streamを使う方法
Dim myFileName As String
Dim myPath As String
Dim NewFileName As String
myFileName = ActiveWorkbook.name
myPath = ActiveWorkbook.Path
Dim outbook As Workbook
Set outbook = ActiveWorkbook
Dim sht As Worksheet
Dim i As Integer
For i = 1 To ActiveWorkbook.Worksheets.Count
Windows(myFileName).Activate
NewFileName = ActiveWorkbook.Worksheets(i).name
Set sht = outbook.Worksheets(i)
Dim StreamIn As Object
Set StreamIn = CreateObject("ADODB.Stream")
With StreamIn
.Open
.Charset = "shift_jis"
.Type = 2
.Position = 0
End With
Dim StreamOut As Object
Set StreamOut = CreateObject("ADODB.Stream")
With StreamOut
.Open
.Charset = "UTF-8"
.Type = 2
.Position = 0
End With
Dim row As Integer
row = sht.UsedRange.Cells(sht.UsedRange.Count).row
Dim line As Integer
line = sht.UsedRange.Cells(sht.UsedRange.Count).Column
Dim fileName As String
fileName = myPath & "\" & NewFileName & ".dat"
Dim r As Integer
For r = 1 To row
Dim l As Integer
For l = 1 To line - 1
StreamIn.WriteText sht.Cells(r, l) & ","
Next
StreamIn.WriteText sht.Cells(r, line), 1
Next
StreamIn.SetEOS
StreamIn.Position = 0
StreamIn.CopyTo StreamOut
StreamOut.SetEOS
StreamOut.Position = 0
StreamOut.SaveToFile fileName, 2
StreamIn.Close
StreamOut.Close
Set StreamIn = Nothing
Set StreamOut = Nothing
Next i
-[[エクセルVBAでBOM無しのUTF-8でCSVファイルなどを出力する方法>https://tonari-it.com/excel-vba-utf8n-bom/]] 2016
**Shift JIS文字列をUTF-8に [#be75801e]
Public Function encodeUTF8(ByRef strUni As String) As Byte()
encodeUTF8 = ADOS_Encode("UTF-8", strUni)
End Function
Private Function ADOS_Encode(ByVal cset As String, ByRef strUni As String) As Byte()
Dim objStm As ADODB.Stream
Set objStm = New ADODB.Stream
objStm.Open
objStm.Type = adTypeText
objStm.Charset = cset
objStm.WriteText strUni
objStm.Position = 0
objStm.Type = adTypeBinary
Select Case UCase(cset)
Case "UNICODE", "UTF-16"
objStm.Position = 2
Case "UTF-8"
objStm.Position = 3
End Select
ADOS_Encode = objStm.Read()
objStm.Close
End Function
**描画抑制 [#m5c0a9fc]
Application.ScreenUpdating = false
**シート並べ替えサンプル [#r4181544]
-１シート目の2行目2列目からシート名を並べておき、その順番に２番目以降のシートを入れ替えるマクロの例（ちょっとバグってるかも…）
Sub シート並べ替え()
Dim bk As Workbook
Set bk = ThisWorkbook
Dim sht As Worksheet
Set sht = ActiveSheet
Dim names() As String
Dim i As Integer
'シート名読み込み
Dim j As Integer
j = 0
For i = 2 To 1000 'とりあえず1000シートまで
If sht.Cells(i, 2) <> "" Then
ReDim Preserve names(j)
names(j) = sht.Cells(i, 2)
j = j + 1
Else
Exit For
End If
Next
For i = 0 To UBound(names)
Dim wsht As Worksheet
Set wsht = bk.Worksheets(names(i))
Call wsht.Move(After:=bk.Worksheets(1 + i))
Next
MsgBox ("OK")
End Sub
**Excelシートアルファベット順並べ替え [#b6d35ae7]
-http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200610/06100285.txt
**列幅を合わせる [#oe1773d9]
'ost は対象シート
ost.Activate
ost.Range(ost.Cells(1, 1), ost.Cells(osr, 8)).Columns.AutoFit
-columnsに対して行うのがポイント
**マクロのあるブック [#cf43f3f0]
-ThisWorkbookで参照
**AddTextBox に渡す座標の渡し方 [#mb19aab1]
-http://www.keep-on.com/excelyou/2001lng4/200102/01020461.txt
-Cells().Leftとか.Topとかを利用するとよい
**ブックのシートインデックスを作る [#h5eba5dc]
-最初のシートに「目次」という名前をつけるのであらかじめ用意しておく
Sub MakeIndex()
Dim s_シート名() As String
Dim mokuji As Worksheet
Set mokuji = Worksheets(1)
mokuji.Name = "目次"
'《目次》シート情報
Dim row As Integer
Dim col As Integer
row = 1
col = 2
' シート名取得
mokuji.Select
Dim J As Integer
For J = 1 To Worksheets.Count
ReDim Preserve s_シート名(J)
s_シート名(J) = Worksheets(J).Name
Next J
mokuji.Activate
' 取得結果反映
Dim K As Integer
For K = 2 To UBound(s_シート名)
Dim sht_name As String
sht_name = s_シート名(K)
If sht_name <> "" Then
Dim rnt As Range
Set rnt = mokuji.Cells(K, col)
mokuji.Hyperlinks.Add _
Anchor:=rnt, _
Address:="", SubAddress:="'" & sht_name & "'!A1", TextToDisplay:=sht_name
mokuji.Cells(K, col).Select
End If
Next K
End Sub
**シートに画像を取り込み、その占めている範囲の右下セルを得る [#l25d83f6]
Dim acs As Worksheet
Set acs = ActiveSheet
acs.Cells(1, 1).Select
acs.Pictures.Insert(画像のpath).Select
Dim r As Range
Set r = acs.Pictures(1).BottomRightCell
**いらないシートを消す [#z5170efa]
Application.DisplayAlerts = False '警告抑制
With outbook
'本当は３つとは限らないが（Excelの設定によって変わるので）、とりあえず
.Worksheets("Sheet1").Delete
.Worksheets("Sheet2").Delete
.Worksheets("Sheet3").Delete
End With
--※シート数を０にはできませんので注意
**プログラムの同期的な実行 [#a45e7192]
-→Visual Basic(.NET以前)のページを見よ
**表示倍率を変える [#kf626c7f]
ActiveWindow.Zoom = 75
**ハイパーリンク作成 [#s57ccf65]
表示文字列 = "hoge"
アドレス = "http://www.kernel-net.ne.jp/tech/"
Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=アドレス, TextToDisplay:=表示文字列
--削除
Range("A1").Hyperlinks.Delete
Range("A1").ClearContents
**印刷設定 右下にページ数を入れる [#ya0551da]
ActiveSheet.PageSetup.RightFooter = "&P/&N"
**印刷範囲の設定 [#b21d0bb9]
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$83" 'A1形式 Rangeではダメです
**RangeからA1形式の文字列を得るには [#k93f604a]
str = Cells(row, col).Address
**Worksheets.AddのAfter引数などで渡すのはシート名ではない [#a9dd6dbf]
-シートの番目でもない。Worksheetのオブジェクトを渡さないといけないので注意
'ブック末尾へのシート追加
Worksheets.Add after:=Worksheets(Worksheets.Count)
-Worksheet.Move や .Copyも同様
**VBAでデータが変わった切れ目で改ページしたい [#d805d981]
-http://oshiete1.goo.ne.jp/qa1919970.html
Worksheets(SheetName).Range("B" + Trim$(Str$(rindex))).Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add ActiveCell '改ページ挿入
ActiveWindow.SelectedSheets.VPageBreaks.Add ActiveCell
**印刷改ページを調整する [#p8c34944]
'印刷ブレーク位置微調整 13桁目だったら右に１つずらす
'直接指定できないのだろうか?
Function adjust_print(st As Worksheet) As Integer
Debug.Print (st.Name)
st.Activate
st.Cells(1, 14).Select
'これでは変わってくれないようだ
If st.VPageBreaks.Count = 0 Then
st.VPageBreaks.Add st.Range("N1")
Else
st.VPageBreaks(1).Location = st.Range("N1")
End If
'こうしないとあわせられないのだろうか?
If st.VPageBreaks(1).Location.Column = 13 Then
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
End If
st.Cells(1, 1).Select
adjust_print = 0
End Function
Sub 印刷位置合わせ()
'
Dim shts As Sheets
Set shts = ActiveWorkbook.Worksheets
Dim i As Integer
Dim st As Worksheet
'対象シート毎
For i = 4 To shts.Count
Set st = shts(i)
Call adjust_print(st)
DoEvents
Next
End Sub
**CSV形式で保存する [#wd906960]
ActiveWorkbook.SaveAs Filename:="hoge.csv", FileFormat:=xlCSV, CreateBackup:=False
**データのある最後の行を返す [#i2c480c9]
e=Worksheets("sheet1").Range("A1").End(xlDown).Row
もしくは
e=Worksheets("sheet1").Range("A65536").End(xlUp).Row 'データ中に空き行がある場合
-上のやり方では、列なら２列以上ないと256が返ってしまうので、下記のようにやる方がいいようだ。
Dim row As Integer
row = sht.UsedRange.Cells(sht.UsedRange.Count).row
Dim line As Integer
line = sht.UsedRange.Cells(sht.UsedRange.Count).Column
-このやり方について[[こちらのblog>http://d.hatena.ne.jp/takayukis/20090329/1238296405]] でご指摘あり。感謝
これは、データの入力の有無に関わらず、セルの一部に書式設定などがされていれば、
有効な範囲として値を返します。
すっきりとしていて、うまく行きそうですが、実は落とし穴になっています。
**ゴールシークを実行させる [#l2d08fb3]
'E3の値が0になるようにB3を変化させる場合
Range("E3").GoalSeek Goal:=0, ChangingCell:=Range("B3")
**ブックを開いてシート毎になにかするサンプル [#a3c4ba90]
Function prcBook(bk As String) As Integer
Debug.Print ("-------book:" & bk & "スタート---------------------")
Dim wbk As Workbook
'指定 xls を開く
'Set wbk = Application.Workbooks(bk)
Set wbk = Workbooks.Open(bk)
wbk.Activate
Dim cnt As Integer
cnt = wbk.Worksheets.Count
Debug.Assert (cnt > 0)
Dim i As Integer
For i = 1 To cnt
Dim wst As Worksheet
Set wst = wbk.Worksheets(i)
Call prcSheet(wst)
Next
wbk.Close
Debug.Print ("-------処理終わり---------------------")
End Function
** VBAプロジェクトをロックする [#i2a1b4c0]
-[[VBAのプロジェクトにパスワードを設定する:VBE(Visual Basic Editor)>https://www.relief.jp/docs/017816.html]] 2012
--プロジェクトのプロパティで「保護」シートで設定する
** VBAファイルのデータ構造 [#h90d8d88]
-[[Evil Clippy: MS Office maldoc assistant | Outflank>https://outflank.nl/blog/2019/05/05/evil-clippy-ms-office-maldoc-assistant/]] 2019
--https://github.com/outflanknl/EvilClippy
--VBAのパスワード外すツール
--バイナリは用意されてないのでソースからコンパイルする必要がある。
Make sure you have Visual Studio installed. Then execute the following command from a Visual Studio developer command prompt:
csc /reference:OpenMcdf.dll,System.IO.Compression.FileSystem.dll /out:EvilClippy.exe *.cs
-[[[MS-OVBA]: Office VBA File Format Structure | Microsoft Docs>https://docs.microsoft.com/en-us/openspecs/office_file_formats/ms-ovba/575462ba-bf67-4190-9fac-c275523c75fc]] 2022.2
-[[OpenMCDF is a 100% .net / C# component that allows developers to manipulate Microsoft Compound Document Files (also known as OLE structured storage).>https://github.com/ironfede/openmcdf/]] 2022.5
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
