ExcelのVBA
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
検索
|
最終更新
|
ヘルプ
|
ログイン
] [
Twitter
]
開始行:
→Office関連メモ
→Excel関連
→C＃によるExcel制御
→Visual Basic(.NET以前)
#contents
* サブトピック [#zd8f2c00]
-ExcelのVBAで図形／シェイプの処理
*一般 [#bbc20b28]
-[[XML 要素を XML マップのセルに対応付ける - Microsoft サ...
-[[【VSCode】XVBAを使ってExcel VBA開発 | とあるエンジニア...
-[[Excel VBAでもう頑張らない | フューチャー技術ブログ>htt...
-VarTypeで8204などが返ってくるとき
-- 配列を指定した場合は、配列(8192)+型番号の値が返ります...
--http://www.openreference.org/articles/view/460
-[[VBAの「ソースコードをロック」ではソースコードをロック...
-[[VBA100本ノック：マクロVBAの特訓｜エクセルの神髄>https:...
-[[エクセルアドインとは>http://hp.vector.co.jp/authors/VA...
-[[エクセルＶＢＡ・マクロ勉強参考サイトまとめ>http://mato...
-[[コントロールの誤操作でマクロが作成される>http://pc.nik...
-[[VB & VBAプログラミング>http://www.ops.dti.ne.jp/~aller...
-[[すぐに役立つVBAマクロ集>http://www.happy500z.com/]]
--[[印刷（基本型）>http://www.geocities.jp/happy_ngi/YNxv...
-[[ExcelRelaxTools Addin>http://software.opensquare.net/r...
--5年間(2009年〜)にわたって作成したマクロを汎用的、体系的...
*Tips [#z68b5d4d]
** 添付ファイルをつけてメール [#p7c0a085]
-[[EXCEL VBAでメール一括配信！添付ファイルも付けられるよ...
** 画面をキャプチャする [#d6d9263d]
-[[Excel VBA を学ぶなら moug モーグ | 即効テクニック | 画...
** Googleマップ表示 [#z16f89c2]
-[[ゼロからはじめるExcel VBA＋Webサービス(9) Googleマップ...
** CSVやExcelにSQLを実行 [#ud98d858]
-[[【Excel VBA】CSVやExcelファイルにSQLを実行するツール -...
** マクロの自動実行を抑制 [#e8efef0f]
-[[マクロを実行させずにExcelファイルを開く方法。ブックオ...
--ファイルを開く→Shiftを押しながら開く
-[[［Excel VBA］マクロの自動実行を止めるには？ | 日経クロ...
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://...
-Win32APIを直叩きしたい場合
--https://www.moug.net/tech/acvba/0020007.html
Public Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" ( _
pOpenFileName As OPENFILENAME) ...
'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, vb...
End Function
** スクレイピング [#l5890357]
-[[時給１０００円の事務員さんのための VBA スクレイピング>...
**アドイン関連 [#c2cf0356]
-[[VBAをリボンUIに追加する（インストーラー付き）>http://q...
** ExcelにGoogle Maps APIで地図を埋め込み、住所検索、拡大...
-http://www.atmarkit.co.jp/ait/articles/1409/05/news165.h...
**開いているファイルの中から名前の左側が引数と合致するフ...
'２つ以上あったらエラー
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) = Str...
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の数式を元に、同じ条件でフィルタをかける [#db5c...
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(", "", ,...
strSuusiki = Replace(strSuusiki, "=countif(", "", , ...
strSuusiki = Replace(strSuusiki, ")", "") '’余分なと...
varPrm = Split(strSuusiki, ",") '’Countifsのパラメー...
If Not sh.AutoFilterMode Then ''オートフィルターが付...
Intersect(sh.UsedRange, sh.Range("10:65535")).Au...
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:=st...
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
**ハイパーリンクをクリックしたら上の行（３行目）にあげる ...
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hy...
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-...
--Range.Hiddenプロパティを見る
-[[オートフィルタ適用後に表示されている行のみを対象に処理...
** 現在見ているブックの全シートから_YMDHMSという値の入っ...
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:=Ac...
LookAt:=xlPart, SearchOrder:=xlByRows, Se...
MatchCase:=False, MatchByte:=False, Searc...
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)) ...
s = .Cells(r.row, r.Column)
Debug.Print (.Name & ":" & r.row ...
.Cells(r.row + 1, r.Column).Numbe...
.Cells(r.row + 1, r.Column).Horiz...
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:="", Rea...
:=False, CreateBackup:=False
**手っ取り早くExcelシートの一覧を得るには [#mb3fd2e2]
-ALT+F11を押下(VBAエディタが起動)
-CTRL+Gを押下(イミディエイトウインドウが起動)
For Each i In ThisWorkbook.Sheets: debug.print i.name : ...
をタイプしてEnterを押下
**［Esc］キーによるExcel VBAの実行中断を防止する [#jd547d...
-http://www.atmarkit.co.jp/fwin2k/win2ktips/1437disescexc...
Application.EnableCancelKey = xlDisabled
**互換性チェックのダイアログが出るのを抑制 [#r83ca239]
-Office2007で .xlsファイルを保存しようとしたときに出るダ...
Application.DisplayAlerts=False
とする
**Excelで特定の値になったときのアクション [#l5ea8ee5]
-特定のセルに特定の値が入力されたときにマクロを自動的に実...
--http://www.asahi-net.or.jp/~zn3y-ngi/YNxv9c7.html
--WorkSheet_Changeのイベントプロシージャに処理を書けば良...
**ツリービューコントロール [#d09d738e]
-[[Tree View Controlの組み込み>http://officetanaka.net/ex...
--「ツール」-「その他のコントロール」から「Microsoft Tree...
-http://www.f3.dion.ne.jp/~element/msaccess/AcTipsFrmUsin...
-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_02...
-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).C...
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ファイルなどを出力する...
**Shift JIS文字列をUTF-8に [#be75801e]
Public Function encodeUTF8(ByRef strUni As String) As By...
encodeUTF8 = ADOS_Encode("UTF-8", strUni)
End Function
Private Function ADOS_Encode(ByVal cset As String, ByRef...
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?pr...
**列幅を合わせる [#oe1773d9]
'ost は対象シート
ost.Activate
ost.Range(ost.Cells(1, 1), ost.Cells(osr, 8)).Columns...
-columnsに対して行うのがポイント
**マクロのあるブック [#cf43f3f0]
-ThisWorkbookで参照
**AddTextBox に渡す座標の渡し方 [#mb19aab1]
-http://www.keep-on.com/excelyou/2001lng4/200102/01020461...
-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 &...
mokuji.Cells(K, col).Select
End If
Next K
End Sub
**シートに画像を取り込み、その占めている範囲の右下セルを...
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形式 R...
**RangeからA1形式の文字列を得るには [#k93f604a]
str = Cells(row, col).Address
**Worksheets.AddのAfter引数などで渡すのはシート名ではない...
-シートの番目でもない。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))).A...
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...
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:=...
**データのある最後の行を返す [#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/t...
これは、データの入力の有無に関わらず、セルの一部に書式設...
有効な範囲として値を返します。
すっきりとしていて、うまく行きそうですが、実は落とし穴に...
**ゴールシークを実行させる [#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 Bas...
--プロジェクトのプロパティで「保護」シートで設定する
** VBAファイルのデータ構造 [#h90d8d88]
-[[Evil Clippy: MS Office maldoc assistant | Outflank>htt...
--https://github.com/outflanknl/EvilClippy
--VBAのパスワード外すツール
--バイナリは用意されてないのでソースからコンパイルする必...
Make sure you have Visual Studio installed. Then execute...
csc /reference:OpenMcdf.dll,System.IO.Compression.FileSy...
-[[[MS-OVBA]: Office VBA File Format Structure | Microsof...
-[[OpenMCDF is a 100% .net / C# component that allows dev...
終了行:
→Office関連メモ
→Excel関連
→C＃によるExcel制御
→Visual Basic(.NET以前)
#contents
* サブトピック [#zd8f2c00]
-ExcelのVBAで図形／シェイプの処理
*一般 [#bbc20b28]
-[[XML 要素を XML マップのセルに対応付ける - Microsoft サ...
-[[【VSCode】XVBAを使ってExcel VBA開発 | とあるエンジニア...
-[[Excel VBAでもう頑張らない | フューチャー技術ブログ>htt...
-VarTypeで8204などが返ってくるとき
-- 配列を指定した場合は、配列(8192)+型番号の値が返ります...
--http://www.openreference.org/articles/view/460
-[[VBAの「ソースコードをロック」ではソースコードをロック...
-[[VBA100本ノック：マクロVBAの特訓｜エクセルの神髄>https:...
-[[エクセルアドインとは>http://hp.vector.co.jp/authors/VA...
-[[エクセルＶＢＡ・マクロ勉強参考サイトまとめ>http://mato...
-[[コントロールの誤操作でマクロが作成される>http://pc.nik...
-[[VB & VBAプログラミング>http://www.ops.dti.ne.jp/~aller...
-[[すぐに役立つVBAマクロ集>http://www.happy500z.com/]]
--[[印刷（基本型）>http://www.geocities.jp/happy_ngi/YNxv...
-[[ExcelRelaxTools Addin>http://software.opensquare.net/r...
--5年間(2009年〜)にわたって作成したマクロを汎用的、体系的...
*Tips [#z68b5d4d]
** 添付ファイルをつけてメール [#p7c0a085]
-[[EXCEL VBAでメール一括配信！添付ファイルも付けられるよ...
** 画面をキャプチャする [#d6d9263d]
-[[Excel VBA を学ぶなら moug モーグ | 即効テクニック | 画...
** Googleマップ表示 [#z16f89c2]
-[[ゼロからはじめるExcel VBA＋Webサービス(9) Googleマップ...
** CSVやExcelにSQLを実行 [#ud98d858]
-[[【Excel VBA】CSVやExcelファイルにSQLを実行するツール -...
** マクロの自動実行を抑制 [#e8efef0f]
-[[マクロを実行させずにExcelファイルを開く方法。ブックオ...
--ファイルを開く→Shiftを押しながら開く
-[[［Excel VBA］マクロの自動実行を止めるには？ | 日経クロ...
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://...
-Win32APIを直叩きしたい場合
--https://www.moug.net/tech/acvba/0020007.html
Public Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" ( _
pOpenFileName As OPENFILENAME) ...
'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, vb...
End Function
** スクレイピング [#l5890357]
-[[時給１０００円の事務員さんのための VBA スクレイピング>...
**アドイン関連 [#c2cf0356]
-[[VBAをリボンUIに追加する（インストーラー付き）>http://q...
** ExcelにGoogle Maps APIで地図を埋め込み、住所検索、拡大...
-http://www.atmarkit.co.jp/ait/articles/1409/05/news165.h...
**開いているファイルの中から名前の左側が引数と合致するフ...
'２つ以上あったらエラー
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) = Str...
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の数式を元に、同じ条件でフィルタをかける [#db5c...
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(", "", ,...
strSuusiki = Replace(strSuusiki, "=countif(", "", , ...
strSuusiki = Replace(strSuusiki, ")", "") '’余分なと...
varPrm = Split(strSuusiki, ",") '’Countifsのパラメー...
If Not sh.AutoFilterMode Then ''オートフィルターが付...
Intersect(sh.UsedRange, sh.Range("10:65535")).Au...
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:=st...
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
**ハイパーリンクをクリックしたら上の行（３行目）にあげる ...
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hy...
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-...
--Range.Hiddenプロパティを見る
-[[オートフィルタ適用後に表示されている行のみを対象に処理...
** 現在見ているブックの全シートから_YMDHMSという値の入っ...
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:=Ac...
LookAt:=xlPart, SearchOrder:=xlByRows, Se...
MatchCase:=False, MatchByte:=False, Searc...
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)) ...
s = .Cells(r.row, r.Column)
Debug.Print (.Name & ":" & r.row ...
.Cells(r.row + 1, r.Column).Numbe...
.Cells(r.row + 1, r.Column).Horiz...
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:="", Rea...
:=False, CreateBackup:=False
**手っ取り早くExcelシートの一覧を得るには [#mb3fd2e2]
-ALT+F11を押下(VBAエディタが起動)
-CTRL+Gを押下(イミディエイトウインドウが起動)
For Each i In ThisWorkbook.Sheets: debug.print i.name : ...
をタイプしてEnterを押下
**［Esc］キーによるExcel VBAの実行中断を防止する [#jd547d...
-http://www.atmarkit.co.jp/fwin2k/win2ktips/1437disescexc...
Application.EnableCancelKey = xlDisabled
**互換性チェックのダイアログが出るのを抑制 [#r83ca239]
-Office2007で .xlsファイルを保存しようとしたときに出るダ...
Application.DisplayAlerts=False
とする
**Excelで特定の値になったときのアクション [#l5ea8ee5]
-特定のセルに特定の値が入力されたときにマクロを自動的に実...
--http://www.asahi-net.or.jp/~zn3y-ngi/YNxv9c7.html
--WorkSheet_Changeのイベントプロシージャに処理を書けば良...
**ツリービューコントロール [#d09d738e]
-[[Tree View Controlの組み込み>http://officetanaka.net/ex...
--「ツール」-「その他のコントロール」から「Microsoft Tree...
-http://www.f3.dion.ne.jp/~element/msaccess/AcTipsFrmUsin...
-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_02...
-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).C...
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ファイルなどを出力する...
**Shift JIS文字列をUTF-8に [#be75801e]
Public Function encodeUTF8(ByRef strUni As String) As By...
encodeUTF8 = ADOS_Encode("UTF-8", strUni)
End Function
Private Function ADOS_Encode(ByVal cset As String, ByRef...
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?pr...
**列幅を合わせる [#oe1773d9]
'ost は対象シート
ost.Activate
ost.Range(ost.Cells(1, 1), ost.Cells(osr, 8)).Columns...
-columnsに対して行うのがポイント
**マクロのあるブック [#cf43f3f0]
-ThisWorkbookで参照
**AddTextBox に渡す座標の渡し方 [#mb19aab1]
-http://www.keep-on.com/excelyou/2001lng4/200102/01020461...
-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 &...
mokuji.Cells(K, col).Select
End If
Next K
End Sub
**シートに画像を取り込み、その占めている範囲の右下セルを...
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形式 R...
**RangeからA1形式の文字列を得るには [#k93f604a]
str = Cells(row, col).Address
**Worksheets.AddのAfter引数などで渡すのはシート名ではない...
-シートの番目でもない。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))).A...
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...
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:=...
**データのある最後の行を返す [#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/t...
これは、データの入力の有無に関わらず、セルの一部に書式設...
有効な範囲として値を返します。
すっきりとしていて、うまく行きそうですが、実は落とし穴に...
**ゴールシークを実行させる [#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 Bas...
--プロジェクトのプロパティで「保護」シートで設定する
** VBAファイルのデータ構造 [#h90d8d88]
-[[Evil Clippy: MS Office maldoc assistant | Outflank>htt...
--https://github.com/outflanknl/EvilClippy
--VBAのパスワード外すツール
--バイナリは用意されてないのでソースからコンパイルする必...
Make sure you have Visual Studio installed. Then execute...
csc /reference:OpenMcdf.dll,System.IO.Compression.FileSy...
-[[[MS-OVBA]: Office VBA File Format Structure | Microsof...
-[[OpenMCDF is a 100% .net / C# component that allows dev...
ページ名:
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
