新しいシートを挿入してボタンを作成するVBA

'新しいシートを挿入
Sub New_Sheet()
    Dim NewWorkSheet As Worksheet
    Dim Sheet_Name As String
    
    Sheet_Name = InputBox("シート名を入力")
    
    Set NewWorkSheet = Worksheets.Add()
    NewWorkSheet.Name = Sheet_Name
    
    Call InsertButtonOnSheet(NewWorkSheet)
    
End Sub

'ボタンを作る
Sub InsertButtonOnSheet(Insert_Sheet As Worksheet)
    Dim ws As Worksheet: Set ws = Insert_Sheet '作るシートを引数で受け取る
    Dim obj As Object
    
    'B2からC3の範囲でボタンを作成
    Set obj = ws.Buttons.Add(Range("B2").Left, _
                                 Range("B2").Top, _
                                 Range("B2:C3").Width, _
                                 Range("B2:C3").Height)
    With obj
        .Characters.Text = "Test Button"  'ボタン表示テキスト
        .OnAction = "Msg_Open"            '登録マクロ名
    End With
End Sub

'登録用サンプルマクロ
Sub Msg_Open()
    MsgBox ("こんにちは")
End Sub

Excel個人用マクロブックが開かない場合の対処方法

何でも相談できる パソコン駈込み寺(⇒詳細)
 


日本IBM出身

ホームページビルダー元開発責任者
鎌田裕二


横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】

 

PERSONAL.XLSBの保存場所

C:\Users\[user]\AppData\Roaming\Microsoft\Excel\XLSTART

(隠しファイルになっているので、ユーザーフォルダで表示しないとAppDataフォルダが見られない)

・読み取り専用になっている。

・名前が変更されている

適宜修正する

Excel側の設定

オプション→アドイン→管理(左下にあるドロップダウンメニュー)→「Excelアドイン」を「使用できないアイテム」に変更→PERSONAL.XLSBが設定されていた有効にする。

何でも相談できる パソコン駈込み寺(⇒詳細)
 
 


日本IBM出身

ホームページビルダー元開発責任者
鎌田裕二


横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】

Excelで色のついたセルが印刷できない場合

セルを塗りつぶしや条件付き書式等で色付けしていて、印刷時に色が出ない場合

「ページレイアウト」タブ→「シートのオプション」詳細→「印刷」項目の「白黒印刷」のチェックをはずす

日本IBM出身ホームページビルダー元開発責任者
鎌田裕二
責任指導横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

エクセルVBA Outlookに添付ファイル

Dim attachment_file As String
attachment_file = “C:\Users\curio\Desktop\section#custom-section_h1_section-title.txt”
mITEM.Attachments.Add attachment_file

日本IBM出身
ホームページビルダー元開発責任者
鎌田裕二
責任指導
横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】
小学生から90才まで通学実績有

エクセル2013オートフィル直後 オートフィルオプションが表示される「クイック分析」が表示される

オプション

詳細

コンテンツを貼り付けるときに[貼り付けオプション]ボタンを表示する

日本IBM出身
ホームページビルダー元開発責任者
鎌田裕二
責任指導
横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】
小学生から90才まで通学実績有

エクセル VBA Outlookを起動して 内容を貼り付ける

Sub send_mail()
Dim i, j As Integer
Dim oApp
Dim myNameSpace
Dim myFolder
‘Outlookの起動

On Error Resume Next
Set oApp = GetObject(, “Outlook.Application”)
If oApp Is Nothing Then
Set oApp = CreateObject(“Outlook.Application”)
Set myNameSpace = oApp.GetNamespace(“MAPI”)
Set myFolder = myNameSpace.GetDefaultFolder(6)
myFolder.Display
End If
On Error GoTo 0

oApp.ActiveWindow.WindowState = 2

‘以下はメールの新規作成
Dim mITEM ‘As Outlook.MailItem’
Set mITEM = oApp.CreateItem(0)
mITEM.BodyFormat = 2
mITEM.Display

mITEM.Subject = Worksheets(“Sheet1”).Cells(1, “a”).Value
mITEM.To = Worksheets(“Sheet1”).Cells(4, “i”).Value
mITEM.CC = Worksheets(“Sheet1”).Cells(4, “j”).Value

‘メールのコピー
Range(“A3”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Range(“A4”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Range(“A5”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Range(“A6”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Worksheets(“Sheet1”).Range(“A7”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘Dim waitTime As Variant
‘waitTime = Now + TimeValue(“0:00:2”)
‘Application.Wait waitTime

‘個数を数える
i = 0
Do While Worksheets(“Sheet1”).Cells(i + 8, “a”).Value <> “”
i = i + 1
Loop
‘Debug.Print i

‘コピー
Worksheets(“Sheet1”).Range(Cells(8, “a”), Cells(8 + i – 1, “g”)).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

End Sub

日本IBM出身
ホームページビルダー元開発責任者
鎌田裕二
責任指導
横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】
小学生から90才まで通学実績有

VBA Excel 実践授業 覚書

Option Explicit
Sub macro_loop2()
Dim i As Integer
i = 2
Do While (Cells(i, 2).Value <> “”)
‘ If i > 50 Then
‘ MsgBox (Cells(i, 2).Value)
‘End If

If Cells(i, 1).Value = 1 Then
MsgBox (Cells(i, 2).Value)

End If

i = i + 1
Loop

End Sub

Sub paste_record_rows()
Dim i As Integer
Dim k As Integer
i = 2 ‘残のレコードへのインデックス
k = 2 ‘パソコン教室フォームのレコードコピー先のインデックス
Do While (Worksheets(“残”).Cells(i, “b”).Value <> “”) ‘発注番号が空でないときに次のブロックを実行=発注番号が空のときはLoopを抜ける
If (Worksheets(“残”).Cells(i, “a”).Value <> “”) Then ‘チェックがたっていたら次の処理をEnd Ifまで実行
Worksheets(“パソコン教室フォーム”).Cells(k, “a”).Value = Worksheets(“残”).Cells(i, “b”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “b”).Value = Worksheets(“残”).Cells(i, “i”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “c”).Value = Worksheets(“残”).Cells(i, “l”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “d”).Value = Worksheets(“残”).Cells(i, “m”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “e”).Value = Worksheets(“残”).Cells(i, “h”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “f”).Value = Worksheets(“残”).Cells(i, “n”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “g”).Value = Worksheets(“残”).Cells(i, “q”).Value
k = k + 1
End If
i = i + 1
Loop

End Sub

Sub all_clear()
Dim i As Integer
i = 2
Do While (Cells(i, 2).Value <> “”)
Cells(i, 1).Value = “”
i = i + 1

Loop

End Sub

日本IBM出身
ホームページビルダー元開発責任者
鎌田裕二
責任指導
横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】
小学生から90才まで通学実績有

VBA 選択範囲の操作

Sub macro1()
Selection.Resize(Selection.Rows.Count – 3).Select
Selection.Offset(3).Select
End Sub

日本IBM出身
ホームページビルダー元開発責任者
鎌田裕二
責任指導
横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】
小学生から90才まで通学実績有

エクセル 絶対参照(絶対行・列参照)実演メモ

=$A$1=$A$1=$A$1
=$A$1=$A$1=$A$1
=$A$1=$A$1=$A$1
=$A$1=$A$1=$A$1
=$A$1=$A$1=$A$1
=$A$1=$A$1=$A$1
   
   
   
=A$1=B$1=C$1
=A$1=B$1=C$1
=A$1=B$1=C$1
=A$1=B$1=C$1
=A$1=B$1=C$1
=A$1=B$1=C$1
=A$1=B$1=C$1
=A$1=B$1=C$1
   
=$A1=$A1=$A1
=$A2=$A2=$A2
=$A3=$A3=$A3
=$A4=$A4=$A4
=$A5=$A5=$A5
=$A6=$A6=$A6
=$A7=$A7=$A7
=$A8=$A8=$A8
=$A9=$A9=$A9
=$A10=$A10=$A10
日本IBM出身
ホームページビルダー元開発責任者
鎌田裕二
責任指導
横浜市鶴見区のパソコン教室⇒

お問い合わせ TEL:045-567-8393

【開校15年 総受講生 1,800名以上】
小学生から90才まで通学実績有