【マクロ】実行後に元のセルに戻る

ボタンを押してマクロ実行後、ボタンがアクティブの状態でマクロが終了する。
元のセルに戻すコードがこれだ。


シートを追加した時などには、アクティブなシートは、意図せずに、変更されてしまいますよね。
とりあえず、選択していたところへ戻る。
Sub 例1()
Dim xCur As Range
Set xCur = Selection
'
'本来行うべき処理のコードをここに記入
'
With xCur
.Parent.Parent.Activate '元のブックへもどる
.Parent.Activate '元のシートへもどる
.Activate 'もとの選択範囲を選択
End With
End Sub

アクティブセルも回復するには

Sub 例２()
Dim xCur As Range, xAct As Range
Set xCur = Selection
Set xAct = ActiveCell
'
'本来行うべき処理のコードを記入
'
With xCur
.Parent.Parent.Activate '元のブックへもどる
.Parent.Activate '元のシートへもどる
.Activate 'もとの選択範囲を選択
End With
xAct.Activate 'アクティブセル回復
End Sub
「元のブックへもどる」「元のシートへもどる」のは、プログラムの状況により、不要になるので、適宜変更してください。

【マクロ】選択範囲を画像ファイルに保存

吐き出した画像はドキュメントの中に保存される。


Sub 選択範囲を画像ファイルに保存()
    With Selection
        .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        With ActiveCell.Worksheet.ChartObjects.Add(.Left, .Top, .Width, .Height)
            With .Chart
                .Paste
                .Export "test.png", "png"
            End With
            .Delete
        End With
    End With
End Sub

【マクロ】条件に合致した行を削除するExcelマクロ

条件に合致した行を削除するExcelマクロ

A列に必ず値が入っていること。

Sub 条件に一致した行を削除する()
　Dim i As Long

　For i = Range("A1").End(xlDown).Row To 2 Step -1
　With Cells(i, "G")
　　If _
　　.Value Like "東京*" Or _
　　.Value Like "大阪*" Then
　　　.EntireRow.Delete
　　End If
　End With
　Next i
End Sub

A列の一番下のデータから上方向に向かってループを回して、
　For i = Range("A1").End(xlDown).Row To 2 Step -1

もしも、G列のデータが「東京」か「大阪」で始まっていたら、
　With Cells(i, "G")
　　If _
　　.Value Like "東京*" Or _
　　.Value Like "大阪*" Then

その行全体を削除しています。
　　　.EntireRow.Delete

上記のマクロは、A列に必ずデータが入っているという条件にしているので、「Range("A1").End(xlDown).Row」というコードでA列の一番下の行番号を取得しています。

もしA列に空白セルが存在する可能性があるのなら「Cells(Rows.Count, 1).End(xlUp).Row」というコードにしましょう

【マクロ】リストからシート連続作成

リストを選択してマクロを実行する。

Sub リストから連続シート作成()
'シート名にしたいセル範囲を指定し実行
  Dim shname As Range
  For Each shname In Selection
        Sheets.Add after:=ActiveSheet
        ActiveSheet.Name = shname.Value
   Next shname
End Sub

【マクロ】使用中のセル範囲を取得（UsedRange プロパティ）

【マクロ】使用中のセル範囲を取得（UsedRange プロパティ）


ActiveSheet.UsedRange.Select


但し書式が設定されていれば書式範囲も含み選択する。

セルをPNG画像として保存する

セルをPNG画像として保存する

引用元：セルをPNG画像として保存する

表を選択し図としてコピーする→貼り付ける→
ファイルをhtmlで名前を付けて保存する→htmlファイルと画像を納めたフォルダが出来る

セルに表示されている内容をそのまま画像としたい場合があります。
他の資料の材料としたい場合などですね。
Excelでの操作は以下の手順になります。
1.画像化したいセル範囲を選択します。
2.ホームタブ→コピー→図としてコピー　を選択します。
3.図のコピーダイアログで、画面に合わせる、ピクチャを選択してOKを押します。
4.ホームタブ→貼り付け→形式を選択して貼り付け　を選択して、図（拡張メタファイル）でOKを押します。
5.ファイル→名前を付けて保存　でダイアログを開きます。
6.ファイルの種類でhtmlを選択します。
7.上書き保存で再発行（または発行）を選択して、保存ボタンを押します。
8.Webページとして発行ダイアログで、OKを押します。
9.保存先のフォルダに～filesというフォルダが出来ているのでその中にPNGファイルが作成されています。

【ソースコード】

セルをPNG画像に変換して保存する関数です。
引数が３つあり、それぞれ、引数1＝作成するPNGファイルを保存するフォルダ、引数2＝PNG画像に変換する単一セルまたは結合セル、引数3＝省略可。作成するPNGファイル名の先頭文字列　を指定します。
filesフォルダに「A1_image001.png」という形式のファイルが作成されます。
引数rが単一セルまたは結合セルを指している場合はxx_image001.pngを採用します。セル範囲を指している場合はxx_image004.pngなのかxx_image999.pngなのかどれが正解なのか判別できないためfilesフォルダを残したままにしています。

'// 引数1：sSaveDir＝作成するPNGファイルを保存するフォルダ
'// 引数2：r As Range＝PNG画像に変換するセル。単一セルまたは結合セルを指定する。
'// 引数3：Optional sFileName = "PNG_"＝作成するPNGファイルのファイル名の先頭文字列。省略可。
Sub CellToPng(sSaveDir, r As Range, Optional sFileName = "PNG_")
    Dim oFso            As FileSystemObject
    Dim sDir                                '// 作成フォルダの一部
    Dim sHtmPath                            '// HTMLファイルのフルパス
    Dim oShape                              '// 貼り付けたセルの図
    Dim sAddress                            '// 座標指定用のセル範囲アドレス
    Dim sAddressStr                         '// ファイル名用のセルアドレス
    Dim sPngFileName                        '// PNGファイル名
   
    Application.ScreenUpdating = False
   
    '// 単一セルの場合
    If (r.Count = 1) Then
        '// 結合セルの場合
        If (r.MergeArea.Count > 1) Then
            '// セル範囲アドレスを取得(A1:B2形式)
            sAddress = r.MergeArea.Address(False, False)
           
            '// 引数のセルが結合セルの左上のセルではない場合
            If (Left(sAddress, Len(r.Address(False, False))) <> r.Address(False, False)) Then
                Exit Sub
            End If
        '// 単一セルの場合
        Else
            '// セルアドレスを取得(A1形式)
            sAddress = r.Address(False, False)
        End If
    '// セル範囲の場合
    Else
        sAddress = r.Address(False, False)
    End If
   
    sAddressStr = Replace(sAddress, ":", "")
   
    '// 対象セル範囲を画像としてコピー
    Range(sAddress).CopyPicture Appearance:=xlScreen, Format:=xlPicture
   
    '// 図として貼り付け（オートシェイプ化）
    ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, DisplayAsIcon:=False
   
    '// 図を移動
    Set oShape = Selection
    oShape.Top = r.Top
    oShape.Left = r.Left
   
    '// HTMLファイル名を設定
    sFileName = Replace(sFileName, "/", "\")
    sFileName = Replace(sFileName, "\", "")
    sSaveDir = Replace(sSaveDir, "/", "\")
    If (Right(sSaveDir, 1) = "\") Then
        sSaveDir = Mid(sSaveDir, 1, Len(sSaveDir) - 1)
    End If
    sDir = sSaveDir & "\" & sFileName & sAddressStr
    sDir = Replace(sDir, "/", "\")
    sDir = Replace(sDir, "\\", "\")
    sHtmPath = sDir & ".htm"
   
    '// HTML形式で保存（ファイル名にセルアドレスを付与する）
    With ActiveWorkbook.PublishObjects.Add(xlSourceRange, sHtmPath, r.Parent.Name, r.Address, xlHtmlStatic, sAddressStr)
        .Publish (True)
        .AutoRepublish = False
    End With
   
    '// 作成したオートシェイプを削除
    Selection.Delete
   
    '// 単一セル指定の場合（セル範囲の場合はPNGファイルが複数出力され、image_xxx.pngのどれが正しいのか不明のため選別しない）
    If (r.Count = 1) Then
        Set oFso = New FileSystemObject
        sPngFileName = sAddressStr & "_image001.png"
       
        '// 既に作成済みの場合は再作成するため削除する
        If (oFso.FileExists(sSaveDir & "\" & sPngFileName) = True) Then
            Call oFso.DeleteFile(sSaveDir & "\" & sPngFileName)
        End If
       
        '// PNGファイルを移動（PNG_A1.filesフォルダから上階層に移動）
        Call oFso.MoveFile(sDir & ".files\" & sPngFileName, sSaveDir & "\" & sPngFileName)
       
        '// PNG_A1.filesフォルダを削除
        Kill sDir & ".files\*"
        RmDir sDir & ".files"
    End If
   
    '// .htmファイルを削除
    Kill sHtmPath
   
    Application.ScreenUpdating = True
End Sub

【テストコード】

上の関数を呼び出すテストコードです。
5行目のループは選択範囲を各セルごとにPNGファイル化しています。
6行目と7行目が上の関数を呼び出す部分です。6行目はコメントアウトしていますが、PNGファイル名の先頭文字を3番目の引数として渡しています。7行目のように省略しても構いません。省略時はPNGファイル名の先頭に「PNG_」と付きます。
11行目は選択範囲をPNGファイル化しています。

Sub CellToPngTest()
    Dim r As Range
   
    '// A1からC1の各セルをPNGファイル化
    For Each r In Selection
'        Call CellToPng("C:\web\test\", r, "\ABC\")
        Call CellToPng("C:\web\test\", r)
    Next
   
    '// A1からC1のセル範囲PNGファイル化
    Call CellToPng("C:\web\test\", Selection)
End Sub

【マクロ】セルに数式を記入する方法

↓エラーが出る書き方
Range("A1") = "=LEFT("tanaka",2)"

文字列は""(ダブルコーテーション)で囲みます。逆に言えば、""(ダブルコーテーション)で囲まれているのは文字列と認識されます。すると、数式として入力しようとしたデータは、「=LEFT(」という文字列＋「tanaka」というコマンド名＋「,2)」という文字列という訳の分からないデータになってしまいます。
「tanaka」を囲む""(ダブルコーテーション)を、文字列の区切りである""(ダブルコーテーション)ではなく、単なるデータとしての""(ダブルコーテーション)とするには、""(ダブルコーテーション)を2つ重ねて記述します。

参照：数式の入力

Range("A1") = "=LEFT(""tanaka"",2)"

これで正しく「=LEFT("tanaka",2)」という数式を入力できます。

ワークシート関数には""(ダブルコーテーション)がひんぱんに使われます。マクロでセルに入力するときには、十分注意して下さい。

参照：数式の入力

【Blender】拡大縮小の時の中心

デフォルトではピボットポイントがアクティブ要素になっているため
拡大縮小をするときにミラーを入れていると割れたり重なったりする。※図1
ピボットポイントを3Dカーソルにすると3Dカーソル(紅白の円)を中心に
拡大縮小できる。※図2・3




図1

図2

図3

【マクロ】A列に値があればB列に連番を入れる

A列に値があればB列に連番を入れる

Sub Macro1()
    Dim i As Long
    Dim N As Long
    For i = 2 To Range("A2").CurrentRegion.Rows.Count
        If Cells(i, "A").Value <> "" Then
            N = N + 1
            Cells(i, "B").Value = N
        End If
    Next i
End Sub



A列に値があればB列にその日の日付を入れる

Sub Macro2()
    Dim i As Long
    For i = 2 To Range("A2").CurrentRegion.Rows.Count
        If Cells(i, "A").Value <> "" Then
            Cells(i, "B").Value = Date
        End If
    Next i
End Sub

【関数】列の最後の値を取得

他にもやり方有るが一番簡単

=INDIRECT("A"&COUNTA(A:A))

【マクロ】セルの数式が計算された時に実行されるイベントプロシージャ

セルの数式が計算された時に実行されるイベントプロシージャとして Worksheet_Calculate イベントがあります。
これを活用されると良いでしょう。

監視対象セル以外のセル範囲に数式が設定されていると、その再計算時にもイベントが発生しますので
別に作業用シートを用意したほうが無難。

例えば Sheet1 の X10 セルの関数の戻り値を監視したい場合。
1)新規シートを追加して、監視用シートとする。
2)追加した監視用シートの A1 セルに 数式で =Sheet1!X10 ..などのように監視対象のセルを参照。
3)監視用シートのシートモジュールに以下のプロシージャを置く。
Private Sub Worksheet_Calculate()
　　If Range("A1").Value <> Range("B1").Value Then
　　　　Range("B1").Value = Range("A1").Value
　　　　MsgBox "change"
　　End If
End Sub

基本的に、Sheet1 の X10 セルの数式が計算されて値が変化した時にCalculateイベントが発生しますが、
数式の内容によっては、値が変わらなくてもCalculateイベントが発生するケースもあります。
また、Sheet1の行削除や挿入時などでもCalculateイベントは反応します。
なので前回計算時の値を別セルに記憶させておいて、値を比較する必要があります。
前述の例では、A1に参照数式があるとして、B1セルを記憶用セルとして使うようにしています。