Excel2000 VBA独習：10年遅れの１年生：So-netブログ

	ブログをはじめるログイン

日	月	火	水	木	金	土
	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

Excel2000 VBA独習ブログトップ
前の16件 | 次の16件

Excel2000VBA 東京電力jukyu-j.csvを取り込む　 [Excel2000 VBA独習]

Excel2000VBA 東京電力jukyu-j.csvを取り込む

今年のjukyu-j.csvには「ピーク時供給力内訳（万kW）」の項目があるので利用する事にしました。

マクロは昨年作成したマクロの使いまわしで、完成とは言えない状態です。

Sub jukyu_j()
'
'東電juyo-j.csvを取り込み、カンマ区切りを展開する
'
'

Dim i, j As Long
Dim 文字, 文字列 As Variant

'
'Workbooks("touden_juyo-j_v103.xls").Activate
'Worksheets("juyo-j").Select
Range("A1", "w350").Delete
'jukyu-j.csvを読み込む
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.tepco.co.jp/forecast/html/images/jukyu-j.csv", Destination:= _
        Range("A1"))
        '.Name = "juyku-j" '読込シート名?
        .Refresh BackgroundQuery:=False
        .Delete 'クエリー削除
    End With

'カンマ区切りを展開
    For i = 1 To 340
        j = 0
        文字列 = Split(Cells(i, "A").Value, ",")

        For Each 文字 In 文字列
            Cells(i, 1 + j + 1) = 文字 'B列から展開
            j = j + 1
        Next
    Next i
End Sub

タグ：EXCEL2000VBA

2012-07-19 15:51 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

Excel2000 xlstartフォルダとExcel.xlb を他のPCにコピーした時の問題点　 [Excel2000 VBA独習]

ExcelVBAを半年ほど休んでいたらパソコンが壊れ、新しいノートＰＣに xlstartフォルダとExcel.xlbを移植した時のメモ

旧ＰＣはWindows2000 新ＰＣはWindowsXp(どこが新なのか！）

以前書いた記事

http://telstar.blog.so-net.ne.jp/2011-06-21-1

マクロを再登録して使用できるようにしていたが、簡単な方法？をみつけた。

マクロボタンにマクロが登録してあり、ボタンを押したときにエラーがでる。が、マクロ登録する時にでる窓に移植前のユーザー名が表示されているのでユーザー名を現在の名前に変更するだけで簡単に登録できる。

黒く反転している所に旧ユーザー名が表示されているので、現在のユーザー名に変更すればいちいちマクロを捜さずに済むので楽？

excel.xlbをテキストエディタで開いた時、赤線の部分がユーザー名

継続は力なり　と言いますがＶＢＡを半年もさぼっていたので、また一からやり直しって感じになりました。
面倒でもつづけていれば良かったかなと反省！

2012-04-04 16:07 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

Excel VBA FTPでファイルを送信する実験　Excel2000 VBA　[Excel2000 VBA独習]

Excel VBA FTPでファイルを送信する実験

ネタ元は　ttp://officetanaka.net/excel/vba/tips/tips47.htm

BASP21　ttp://www.hi-ho.ne.jp/~babaq/basp21.html

Windows2000SP4 環境では、 BASP21-2003-0211.exe をダウンロードし実行してインストールする。
他のファイルだとインストール出来なかった。

マクロは、Ofiice田中様のコードで実験し、ファイルをアップロードできた。感謝！

追記　
Basp21　を有効にするかな？

Sub FTP_atpages()
    Dim FTP, rc As Long, Server As String, User As String, Pass As String
    Dim Target As String, Folder As String
    Set FTP = CreateObject("basp21.FTP")    ''FTPオブジェクト
    Server = "www14.atpages.jp"                ''ホストアドレス
    User = "*****"                    ''ユーザー名
    Pass = "*****"                       ''パスワード
    Target = Application.GetOpenFilename() ''送信ファイル
    If Target = "False" Then Exit Sub
    Folder = "/telstar"                     ''送信フォルダ
    rc = FTP.Connect(Server, User, Pass)
    If rc <> 0 Then
        MsgBox "FTP接続できませんでした。", vbCritical
        FTP.Close
        Exit Sub
    End If
    rc = FTP.PutFile(Target, Folder)
    If rc <> 1 Then
        MsgBox Dir(Target) & "を送信できませんでした。", vbCritical
        FTP.Close
        Exit Sub
    End If
    MsgBox Dir(Target) & "を送信しました。", vbInformation
    FTP.Close
End Sub

FTP.EXEを利用する
ネタ元　ttp://www.ken3.org/vba/backno/vba149.html
これもいいかも

FTP.EXEの使い方(C:\WINNT\system32\FTP.EXE)
「ファイル名をして実行」で、FTPと入力
太字の所が入力部分

ftp> open ftp006.upp.so-net.ne.jp
Connected to ftp006.upp.so-net.ne.jp.
220 FTP server ready.
User (ftp006.upp.so-net.ne.jp:(none)): telstar
331 Password required for telstar
Password:********(表示されない）
230 User telstar logged in
ftp> cd public_html
250 CWD command successful
ftp> dir
200 PORT command successful
150 Opening ASCII mode data connection for file list
-rw----r--   1 telstar upage        7846 Sep 14 07:15 001.html
-rw----r--   1 telstar upage        4079 Aug 11 08:24 20110810.csv
-rw----r--   1 telstar upage     1166567 Aug 7 14:43 addressDB.csv

タグ：Excel2000 VBA FTP

2011-09-13 11:49 nice!(0) トラックバック(0)
共通テーマ：パソコン・インターネット

ユーザー定義関数をアドインにする　実験　Excl2000 VBA　[Excel2000 VBA独習]

ユーザー定義関数をアドインにする　実験　Excl2000 VBA

範囲の背景色が有るセルの個数を調べるマクロ「関数名　BGColorCount(範囲) 」

Function BGcolorCount(celR As Range)
　Dim myR As Range
　Dim x As Long
x = 0
   For Each myR In celR
   '背景色が白でなければカウントを＋１
          If myR.Interior.Color <> RGB(255, 255, 255) Then x = x + 1
   Next myR
BGColorCount = x
End Function

アドイン化（アドイン化するメリット、全てのブックで使用できる）
上記のマクロをブックに追加する
「名前を付けて保存」でファイルの種類で拡張子xlaを選択し、名前を付けて保存する。(例　背景色カウント.xla)

アドインとして追加
メニューバーのツール→アドインを選択し、アドインダイアログが表示されたら、右側の「参照」参照ボタンを押し先ほど保存した＊＊＊.xlaを選択して追加する。

Excelで利用するには、BGcolorCount(A1:A10) のようにセルに記入する。（A1からA10)の範囲の背景色のあるセルの個数を計算する。

ユーザー定義関数は自動で計算しないので、再計算する必要がある（Ctrl+Alt+F9)や下記のマクロを実行する。

ユーザ定義関数（アドイン）を再計算するマクロ（ブック全体）
Sub 再計算()
Application.CalculateFull
End Sub

ユーザ定義関数（アドイン）を再計算するマクロ（シートだけ））
Sub 再計算()
Application.Calculate
End Sub

ワークシートイベントとして下記のマクロをシートに追加すれば、自動計算風になるかも
（セルの選択を替えた時に再計算を実行する）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　Application.CalculateFull
End Sub

タグ：Excel2000 VBA

2011-09-11 11:55 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

VBA 右クリックメニュー追加、サブメニュー有り　Excel2000 VBA　[Excel2000 VBA独習]

VBA 右クリックメニュー追加、サブメニュー有り

PERSONAL.XLSなどxlStartフォルダないのxlsファイルの標準モジュールに記述
　Excelを起動すると、auto_openでマクロ（右クリックメニューサブ有り2）を読み込み右クリックメニューを設定する

Sub Auto_Open()
call 右クリックメニューサブ有り2
End Sub

Sub 右クリックメニューサブ有り2()
'
'参考サイト　http://www.seiji-tsubosaki.net/ExcelTech/ExcelProfessionalEngineerTechnic/Contents_03.htm
'

' 右クリックメニューを初期設定に戻す(このマクロで設定したメニューを削除）
    Application.CommandBars("Cell").Reset
'------ 右クリックメニューを設定 ------
    '右クリックサブメニュー無し
      With Application.CommandBars("cell").Controls.Add()
      .Caption = "書式の貼り付け"
      .OnAction = "書式の貼り付け"
      .BeginGroup = True
      End With
      With Application.CommandBars("cell").Controls.Add()
      .Caption = "罫線を除く全ての貼り付け"
      .OnAction = "罫線を除く全て貼り付け"
      .BeginGroup = False
      End With
      With Application.CommandBars("cell").Controls.Add()
      .Caption = "数式の貼り付け"
      .OnAction = "数式の貼り付け"
      .BeginGroup = False
      End With
      With Application.CommandBars("cell").Controls.Add()
      .Caption = "リンク貼り付け (&L)"
      .OnAction = "リンク貼り付け"
      .BeginGroup = False
      End With
      With Application.CommandBars("cell").Controls.Add()
      .Caption = "自動セル幅"
      .OnAction = "自動セル幅"
      .BeginGroup = False
      End With
       With Application.CommandBars("cell").Controls.Add()
      .Caption = "条件付き書式の削除"
      .OnAction = "条件付き書式の削除"
      .BeginGroup = False
      End With
    ' 右クリックメニューサブメニューあり
    With Application.CommandBars("Cell") _
        .Controls.Add(Type:=msoControlPopup)
        .BeginGroup = True                     '区切り線
        .Caption = "シートツール"                     '追加項目
        With .Controls.Add(Type:=msoControlButton)    'サブ項目１
            .Caption = "数式保護"           'サブ項目１表示名
            '.FaceId = 8                            'アイコン番号
            .OnAction = "シートの数式を選択出来ないようにする"                '実行するマクロ
        End With
          With .Controls.Add(Type:=msoControlButton)    'サブ項目２
              .Caption = "シートイベント有効無効"                'サブ項目２表示名
              '.FaceId = 167                             'アイコン番号
              .OnAction = "シートイベント有効無効"                '実行するマクロ
          End With

      End With

End Sub

登録するマクロ例

Sub 自動セル幅()
'列幅を自動調整
ActiveSheet.Select
Range("A:IV").Columns.AutoFit
End Sub
Sub 条件付き書式の削除()
'
'選択範囲の条件付き書式を削除する
'
'
Dim syori As String

syori = MsgBox("選択範囲の条件付き書式を削除するには「はい」を" & vbCrLf & vbCrLf & "キャンセルするには「いいえ」を押してください", vbYesNo, "条件付き書式の削除")
Select Case syori
    Case vbYes
    Selection.FormatConditions.Delete
    Case vbNo
    Exit Sub
End Select

End Sub
Sub 罫線を除く全て貼り付け()
    Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub
Sub 書式の貼り付け()
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
End Sub
Sub 数式の貼り付け()
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
End Sub
Sub リンク貼り付け()
    ActiveSheet.Paste Link:=True
End Sub
Sub シートイベント有効無効()
'実行する度に有効→無効→有効
Select Case Application.EnableEvents
    Case True
        Application.EnableEvents = False
        Application.StatusBar = "シートイベント無効"
    Case False
        Application.EnableEvents = True
        Application.StatusBar = "シートイベント有効"
End Select
End Sub
Sub シートの数式を選択出来ないようにする()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
On Error GoTo owari
Dim W_Book As Workbook
Dim book_name, sheet_name, myProcName As String
Dim i, end_line As Long
'アクティブブック名シート名取得（モジュールを追加する）
    book_name = ActiveWorkbook.Name
    sheet_name = ActiveSheet.Name
'book set
    Set W_Book = Workbooks(book_name)

'書き込むプロシージャ名と同じ名があるかチェック

    myProcName = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"

    With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
        'end_line = .CountOfLines
        For i = 1 To .CountOfLines
        'Debug.Print .Lines(i, 1)
            If myProcName = .Lines(i, 1) Then GoTo owari
            'Debug.Print .Lines(i, 1) '1行ずつコード
        Next i
    End With

'挿入書き込み
With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
          .insertlines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
          .insertlines 3, "If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select"
          .insertlines 4, "End Sub"
End With
Set W_Book = Nothing
MsgBox "シートの数式保護（選択不可）完了"
Exit Sub
owari:
    Set W_Book = Nothing
    MsgBox "既にプロシージャが存在します。"
End Sub

2011-09-07 13:34 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

シートイベントの有効無効と状態をステータスバーに表示　Excel2000 VBA　[Excel2000 VBA独習]

シートイベントの有効無効と状態をステータスバーに表示

Sub シートイベント有効無効()
'実行する度に有効→無効→有効
Select Case Application.EnableEvents
    Case True
        Application.EnableEvents = False
        Application.StatusBar = "シートイベント無効"
    Case False
        Application.EnableEvents = True
        Application.StatusBar = "シートイベント有効"
End Select
End Sub

上記のタグ(sonetブログのCSSに追加）始めのドットを記述
.box1 { width: auto; height: auto; background-color: #aaaaee; padding: 8px; word-wrap:break-word;}
幅（自動）高さ（自動）背景色（色）内側の余白（8px）自動折り返し）

記事編集のhtml編集で
<div class="box1">文書</div>
と記述

2011-09-06 06:31 nice!(0) コメント(0) トラックバック(1)
共通テーマ：パソコン・インターネット

InputBoxで設定した範囲だけ選択出来るようにする（シートにマクロ自動設定）　Excel2000 VBA　[Excel2000 VBA独習]

InputBoxで設定した範囲だけ選択出来るようにする（シートにマクロ自動設定）

最初にワークシートイベントを有効、無効にするマクロ作成する。（無効にしてシートの数式編集など、有効にして入力作業）

Sub シートイベント有効無効()
’実行する度に有効→無効→有効→
If Application.EnableEvents = False Then Application.EnableEvents = True Else Application.EnableEvents = False
End Sub

Sub 設定範囲だけ選択できるようにする()
'「シートイベントで名前のある範囲だけ選択できる（入力）ようにする。」、
'コードをシートモジュールにに追記する
'On Error GoTo Er
Dim W_Book As Workbook
Dim book_name, sheet_name, myProcName As String
Dim i, end_line As Long
'アクティブブック名シート名取得（モジュールを追加する）
    book_name = ActiveWorkbook.Name
    sheet_name = ActiveSheet.Name
'book set
    Set W_Book = Workbooks(book_name)

'書き込むプロシージャ名と同じ名があるかチェック

    myProcName = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"

    With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
        'end_line = .CountOfLines
        For i = 1 To .CountOfLines
        'Debug.Print .Lines(i, 1)
            If myProcName = .Lines(i, 1) Then GoTo owari
            'Debug.Print .Lines(i, 1) '1行ずつコード
        Next i
    End With

'挿入書き込み
With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
          .insertlines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
          .insertlines 3, "On Error Resume Next"
          .insertlines 5, "Dim scope As Range"
          .insertlines 6, "Dim today_row As Long"
          .insertlines 7, "Set scope = Range(" & Chr(34) & "入力" & Chr(34) & ")"
          .insertlines 8, "With Application"
          .insertlines 9, "If .Intersect(Target, scope) Is Nothing Then"
          .insertlines 10, ".EnableEvents = False"
          .insertlines 11, ".PreviousSelections(1).Select"
          .insertlines 12, ".EnableEvents = True"
          .insertlines 13, "Else"
          .insertlines 14, ".Goto ActiveCell"
          .insertlines 15, "End If"
          .insertlines 16, "End With"
          .insertlines 17, "If Target.HasFormula = True Then Target.Offset(0, 1).Select"
          .insertlines 18, "Set scope = Nothing"
          .insertlines 19, "End Sub"
          .insertlines 20, ""

End With
Set W_Book = Nothing

'INputBoxで選択できる範囲を設定
hani_set:
Dim hani As Range
Dim inC As String
On Error GoTo Er
'ワークシートイベントを無効にする
    Application.EnableEvents = False
'範囲取得
    inC = "名前を付ける範囲を指定（名前「入力」）" & vbLf + vbLf & "Ctrlキーを押しながら複数の範囲指定も可" _
    & vbLf + vbLf & "注意　現在設定されている名前は無効になります。"

    Set hani = Application.InputBox(inC, Type:=8)

'選択範囲に名前をつける。名前は「入力」
    hani.Name = "入力"
    'hani.Names.Add Name:="入力", RefersTo:=sheet_name, Visible:=False
    hani.Interior.ColorIndex = 6 '名前をつけた範囲を分かりやすくする為色を設定

'ワークシートイベントを有効にする
    Application.EnableEvents = True

Set hani = Nothing
MsgBox "設定範囲だけ選択可　完了"
Exit Sub
owari:
Dim MB As Variant
    Set W_Book = Nothing
MB = MsgBox("既にプロシージャが存在します。" & vbCrLf + vbCrLf & "範囲を設定しますか？", vbYesNo)
Select Case MB
Case vbYes
    GoTo hani_set
    Case vbNo
    Set hani = Nothing
End Select
Er:
'InputBoxでキャンセルが押されてエラーになったら
End Sub

ダウンロードは🎥こちら

タグ：Excel2000 VBA

2011-09-05 15:08 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

シートの数式を保護（選択出来ないようにする）コードをシートに追記するマクロ　Excel2000 VBA　[Excel2000 VBA独習]

シートの数式を保護（選択出来ないようにする）コードをシートに追記するマクロの実験

マクロを実行すると、シートモジュールにシートイベントのコードを追記して数式が設定されているセルを選択すると右に移動する。
コードが存在していればコードの追記は行わない。

最初にワークシートイベントを有効、無効にするマクロ作成する。（無効にしてシートの数式編集など、有効にして入力作業）

シートにコード追記するマクロ（実験段階）

Sub シートの数式を選択出来ないようにする()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
'On Error GoTo owari
Dim W_Book As Workbook
Dim book_name, sheet_name, myProcName As String
Dim i, end_line As Long
'アクティブブック名シート名取得（モジュールを追加する）
    book_name = ActiveWorkbook.Name
    sheet_name = ActiveSheet.Name
'book set
    Set W_Book = Workbooks(book_name)

'書き込むプロシージャ名と同じ名があるかチェック

    myProcName = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"

    With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
        'end_line = .CountOfLines
        For i = 1 To .CountOfLines
        'Debug.Print .Lines(i, 1)
            If myProcName = .Lines(i, 1) Then GoTo owari
            'Debug.Print .Lines(i, 1) '1行ずつコード
        Next i
    End With

'挿入書き込み
With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
          .insertlines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
          .insertlines 3, "If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select"
          .insertlines 4, "End Sub"
End With
Set W_Book = Nothing
MsgBox "シートの数式保護（選択不可）完了"
Exit Sub
owari:
    Set W_Book = Nothing
    MsgBox "既にプロシージャが存在します。"
End Sub

タグ：Excel2000 VBA

2011-09-05 06:08 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

アクティブシートモジュールにコードを挿入する実験　Excel2000 VBA　[Excel2000 VBA独習]

アクティブシートモジュールにコードを挿入する実験

Sub シートにコードを挿入()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
On Error GoTo owari
Dim W_Book As Workbook
Dim book_name, sheet_name As String
'アクティブブック名シート名取得（モジュールを追加する）
    book_name = ActiveWorkbook.Name
    sheet_name = ActiveSheet.Name
'シートモジュールにコードを挿入
    Set W_Book = Workbooks(book_name)

With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
          .insertlines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
          .insertlines 3, "If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select"
          .insertlines 4, "End Sub"
End With
owari:
    Set W_Book = Nothing
End Sub

2重書き込みかチェックするバージョン

Sub シートにコードを挿入()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
On Error GoTo owari
Dim W_Book As Workbook
Dim book_name, sheet_name, myProcName As String
Dim i As Long
'アクティブブック名シート名取得（モジュールを追加する）
    book_name = ActiveWorkbook.Name
    sheet_name = ActiveSheet.Name
'book set
    Set W_Book = Workbooks(book_name)

'書き込むプロシージャ名と同じ物があるかチェック
    myProcName = "Worksheet_SelectionChange"

    With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule

        For i = 1 To .CountOfLines
            If myProcName = .ProcOfLine(i, 0) Then GoTo owari
            'Debug.Print .ProcOfLine(i, 0)
        Next i
    End With

'挿入書き込み
With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
          .insertlines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
          .insertlines 3, "If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select"
          .insertlines 4, "End Sub"
End With
Set W_Book = Nothing
Exit Sub
owari:
    Set W_Book = Nothing
    MsgBox "既にプロシージャが存在します。"
End Sub

タグ：Excel2000 VBA

2011-09-04 16:18 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

設定した名前つきセルだけ選択(入力)できるようにする実験　Excel2000 VBA　[Excel2000 VBA独習]

設定した名前つきセルだけ選択(入力)できるようにする実験

入力（選択）出来るようにしたいセル（範囲）に「入力」と名前の設定をする。
名前の設定方法は、挿入→名前→定義から設定する。

下記のコードをシートのコード欄に記述

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Dim scope As Range
   Dim today_row As Long
'名前つきセルの範囲を設定
   Set scope = Range("入力")

'選択セル判定
   With Application
      If .Intersect(Target, scope) Is Nothing _
      Then
         .EnableEvents = False
         .PreviousSelections(1).Select
         .EnableEvents = True
      Else
         .Goto ActiveCell
      End If
   End With
'数式セルは選択出来ないようにする（数式ならば右移動）
'If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
   Set scope = Nothing

End Sub

選択範囲に「入力」の名前をつける。（選択可能にする）

Sub 選択セル範囲に名前を付ける()
'

On Error GoTo owari
Dim hani As Range
Dim inC As String

'ワークシートイベントを無効にする
    Application.EnableEvents = False
'範囲取得
    inC = "名前を付ける範囲を指定（名前「入力」）" & vbLf + vbLf & "Ctrlキーを押しながら複数の範囲指定も可" _
    & vbLf + vbLf & "注意　現在設定されている名前は無効になります。"
    Set hani = Application.InputBox(inC, Type:=8)

'選択範囲に名前をつける。名前は「入力」
    hani.Name = "入力"
    hani.Interior.ColorIndex = 6 '名前をつけた範囲を分かりやすくする為色を設定

'ワークシートイベントを有効にする
    Application.EnableEvents = True
owari:
Set hani = Nothing
End Sub

Sub 選択セル範囲に名前を付ける()
'ワークシートイベントを無効してから実行
'ワークシートイベントを無効にする
    Application.EnableEvents = False
'選択範囲に名前をつける。名前は「入力」
    Selection.Name = "入力"
    'Selection.Interior.ColorIndex = 6 '名前をつけた範囲を分かりやすくする為色を設定
'ワークシートイベントを有効にする
    Application.EnableEvents = True
End Sub

Sub シートイベント有効無効()
If Application.EnableEvents = False Then Application.EnableEvents = True Else Application.EnableEvents = False
End Sub

タグ：Excel2000 VBA

2011-09-03 13:02 nice!(0) コメント(9) トラックバック(0)
共通テーマ：パソコン・インターネット

今日の日付の行だけ入力出来るようにする実験　Excel2000 VBA　[Excel2000 VBA独習]

今日の日付の行だけ入力出来るようにする実験

前記事のつづき

今日の日付がある行を調べ、それ以外の行を選択したら選択していたセルに移動する。
選択セルに数式が設定されていれば、右に移動する。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Dim scope As Range
   Dim today_row As Long
'今日の日付行
   today_row = ActiveSheet.Cells.Find(Date).Row
'入力許可範囲の設定
   Set scope = Range(Cells(today_row, 2), Cells(today_row, 255))
'選択セル判定
   With Application
      If .Intersect(Target, scope) Is Nothing _
      Then
         .EnableEvents = False
         .PreviousSelections(1).Select '選択していたセルを選択
       .EnableEvents = True
      Else
         .Goto ActiveCell
      End If
   End With
'数式セルは選択出来ないようにする（数式ならば右移動）
If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
   Set scope = Nothing
End Sub

ダウンロードは🎥こちら

今日の日付がない場合の対処あり実験

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Dim scope As Range
   Dim today_row As Long
'今日の日付行
   today_row = ActiveSheet.Cells.Find(Date).Row
   '今日の日付が無ければ
   If today_row < 1 Then GoTo owari

'入力許可範囲の設定
   Set scope = Range(Cells(today_row, 2), Cells(today_row, 255))
'選択セル判定
   With Application
      If .Intersect(Target, scope) Is Nothing _
      Then
         .EnableEvents = False
         .PreviousSelections(1).Select 'Cells(today_row, 2).Select
         .EnableEvents = True
      Else
         .Goto ActiveCell
      End If
   End With
'数式セルは選択出来ないようにする（数式ならば右移動）
If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
   Set scope = Nothing
Exit Sub
owari:
Application.EnableEvents = False
   MsgBox "今日の日付に該当するセルがありません。" & vbLf + vbLf & "シートイベントを無効にしました。"
End Sub

タグ：Excel2000 VBA

2011-09-03 09:46 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

設定した範囲だけ入力出来るようにする実験　Excel2000 VBA　[Excel2000 VBA独習]

ワークシートイベントを使用して、設定した範囲だけ入力出来るようにする実験

参照サイト　ttp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=37443;id=excel

シートの保護とか、スクロール範囲とかで入力できるセルを制限してみたが、どれも満足いくものではなかった。
今回試したマクロは十分実用になる。

コピペですけど（以下のコードをワークシートのコード欄に記述）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   With Application
      If .Intersect(Target, Range("A1:B10, F1:G10")) Is Nothing _
      Then
         .EnableEvents = False
         .PreviousSelections(1).Select
         .EnableEvents = True
      Else
         .Goto ActiveCell
      End If
   End With
End Sub

今後の課題として、セル（範囲）に名前をつけ、名前から入力できる範囲を設定する。
早急にやりたいことは、今日の日付行だけ入力出来るようにする。

ダウンロードは🎥こちら

ワークシートイベントを有効無効、シートの編集をする時は無効にする。

タグ：Excel2000 VBA

2011-09-03 08:55 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

So-netブログ投稿日からハイパーリンクを作成する実験　Excel2000 VBA　[Excel2000 VBA独習]

So-netブログ投稿日からハイパーリンクを作成する実験　Excel2000 VBA

自分が書いた記事を参照したい時、ハイパーリンクをクリックして記事を表示できるようにする為マクロを作成

B列に「投稿日」C列に「記事番号」（１日に複数投稿したとき）D列に「記事名」E列にハイパーリンクを作成（文字は＊）

B列をドラッグして範囲選択（日付）しマクロ実行

Sub 日付からハイパーリンク作成()
'so-netブログの日付から該当するURLを作成しハイパーリンクを作る
    Dim url, url2, myDate As String
    Dim myR As Range
'ブログURL
    url = "http://telstar.blog.so-net.ne.jp/"
'範囲　事前にドラッグして範囲を選択しておく
    If Selection.Column <> 2 Then MsgBox "B列のみを選択してください": Exit Sub
'選択範囲から１行ずつ処理
    For Each myR In Selection
        myDate = ""
        countDoc = ""
        url2 = ""
    If myR.Offset(0, 2) = "" Then GoTo tugi
        myDate = myR    'B列の日付
        countDoc = myR.Offset(0, 1).Value   '記事が何番目か
'日付を整形 /を-に置換
    myDate = left(myDate, 10)
    myDate = Replace(myDate, "/", "-")
    myDate = Replace(myDate, "年", "-")
    myDate = Replace(myDate, "月", "-")
'Debug.Print myDate & "   " & countDoc
'記事番号　１日に複数投稿した場合、1つ目は無し　２つ目は　1 ３つ目は　２
'例　http://telstar.blog.so-net.ne.jp/2011-08-30-1
    If countDoc = "" Then
        url2 = url & myDate '例　http://telstar.blog.so-net.ne.jp/2011-08-30
    Else
        url2 = url & myDate & "-" & countDoc '例　http://telstar.blog.so-net.ne.jp/2011-08-30-1
    End If
        'Debug.Print url2
'E列にハイパーリンク作成
    ActiveSheet.Hyperlinks.Add Anchor:=myR.Offset(0, 3), Address:=url2, TextToDisplay:="※"
tugi:
    Next myR
End Sub

ハイパーリンクを削除するマクロ例
Sub ハイパーリンクと表示文字列を削除する()
    Range("A1").Hyperlinks.Delete
    Range("A1").ClearContents
End Sub

ハイパーリンクの書式を変更するには、メニューバーの書式→スタイルから変更する。

変更ボタンを押してセルの書式設定ダイアログで下線の有り無し、フォントサイズ、色などを設定する。

タグ：Excel2000 VBA So-netブログ

2011-09-02 07:16 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

ワークシートイベントで数式、指定文字列の保護（セル結合がある場合）の実験 Excel2000 VBA　[Excel2000 VBA独習]

ワークシートイベントで数式、指定文字列の保護（セル結合がある場合）の実験

エクセルで無料テンプレートの請求書をDLして、利用するに当たって変更されては困る文字列と数式を保護する事にした。
ここで問題が発生、ワークシートイベントで数式のあるセルを選択したら右のセルを選択するようにして、数式を保護してみたが結合セルでは巧くいかなっかたので、一工夫した。

選択セルに数式があれば右のセルを選択（シートのコードに記述）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select
End Sub

上記のコードでは結合セルに数式があると右に移動しない。そこで下記のようにしてみた。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.HasFormula = False And Selection.MergeCells Then Exit Sub
If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select: Exit Sub
If Target.MergeCells Then ActiveCell.Offset(0, 1).Select
End Sub

結合セルに数式が有る場合は　
If Target.MergeCells Then ActiveCell.Offset(0, 1).Select　を実行する。
つまり、結合セルだから移動

次に結合セルだが、数式が無しで記入したい場合も移動してしまうのでNG。
そこで、一行目に　
If Target.HasFormula = False And Selection.MergeCells Then Exit Sub　を記述して回避する。

保護したい文字列はどうすかは、数式化して選択したら右に移動するようにする。
If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select: Exit Sub
例　請求書　を記述されているセルは　=("請求書")とし数式化する。

動画
http://www14.atpages.jp/nokie/telstar/swf/excel2.swf.html

タグ：Excel2000 VBA

2011-09-01 08:27 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

PERSONAL.XLSのプロシージャ一覧を表示選択しVBEを開く,モジュールコードを出力する実験 Excel2000 VBA　[Excel2000 VBA独習]

PERSONAL.XLSのプロシージャ一覧を表示選択しVBEを開く,モジュールコードを出力する実験

Excel2002以降は「Visual Basicプロジェクトへのアクセスを信頼する」チェックボックスをオンにする。
　http://officetanaka.net/excel/vba/vbe/01.htm 　参照

Sub プロシージャ名一覧リストボックス()
'このマクロをPERSONAL.XLSの標準モジュールに記載
'ユーザーフォームのリストボックスに一覧を表示
'事前にユーザーフォームを作成
'参考にしたサイト
'http://www.officetanaka.net/excel/vba/vbe/05.htm

On Local Error Resume Next 'エラーが出るのでエラーが出ても実行
    Dim buf As String
    Dim procNames(100) As String
    Dim i, j, p, cou As Long
    Dim x As Long
    Dim moduleName, z As Variant
    Dim mN(20) As String
    Dim VBcop_count As Integer
    Dim moji, moji_1 As Variant

'ThisWorkbookのモジュール数を調べる　数が合わないような・・・
    VBcop_count = ThisWorkbook.VBProject.VBComponents.count

'モジュール名取得
    For Each moduleName In ThisWorkbook.VBProject.VBComponents
        If (moduleName.Type = 1 Or moduleName.Type = 2) And moduleName.Name <> "VBE" Then
        i = i + 1
        mN(i) = moduleName.Name
        'Debug.Print mN(i)
        End If
    Next
'プロシージャ名取得
    For x = 1 To VBcop_count

    With ThisWorkbook.VBProject.VBComponents(mN(x)).CodeModule
       ' Debug.Print mN(x)
        For i = 1 To .CountOfLines
            If buf <> .ProcOfLine(i, 0) Then
            buf = .ProcOfLine(i, 0)
            procNames(j) = mN(x) & vbTab & buf
            'Debug.Print procNames(j)
            j = j + 1
            cou = cou + 1 'プロシージャ数
            End If
        Next i
    End With
    Next x

'---- フォームにプロシージャ一覧を表示 ----
'1-3行目に項目名を設定
    UserForm4.ListBox1.AddItem "PERSONAL.XLS"
    UserForm4.ListBox1.AddItem "モジュール名　　プロシージャ名"
    UserForm4.ListBox1.AddItem " "
        For i = 1 To cou
             UserForm4.ListBox1.AddItem procNames(i)
             UserForm4.ListBox1.AddItem " "
        Next i
'ユーザーフォームをモードレスで開く（他の作業が出来る）
    UserForm4.Show vbModeless

End Sub

Private Sub CommandButton3_Click()

'リストボックスで取得したモジュールないコードをTEXT出力
'
On Error Resume Next
Dim strText, book_name, saveD, moduleName As String
Dim strL, i, endP As Integer
Dim MyCodeModule As Object

'選択文字列を取得
    strText = ListBox1.Text     'モジュール名+vbTab+プロシージャ名
    strL = Len(strText)
    For i = 1 To strL
        If Mid(strText, i, 1) = vbTab Then endP = i: Exit For
    Next i
'vbTabの位置から左側を取得（モジュール名）-1はvbTABを含まないように
    moduleName = Left(strText, endP - 1)

'モジュール名からモジュール内のコードをTEXT出力
    Open "D:\bk\office\VBA\" & ThisWorkbook.Name & "_" & moduleName & ".txt" For Output As #1
    Set MyCodeModule = ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
        If MyCodeModule = "" Then MsgBox "モジュールを取得できませんでした。": Exit Sub

    For i = 1 To MyCodeModule.CountOfLines
         saveD = saveD & MyCodeModule.Lines(i, 1) & vbCrLf
         'Debug.Print saveD
    Next i

    Print #1, saveD
    Close #1
    Set MyCodeModule = Nothing
    MsgBox "完了"
'ファイルを開く
Dim WSH
    Dim URL As String
    Set WSH = CreateObject("Wscript.Shell")
    WSH.Run "D:\bk\office\VBA\" & ThisWorkbook.Name & "_" & moduleName & ".txt"
    Set WSH = Nothing
''エクスプローラを開く
'Dim myFolder As String
''フォルダの設定
'    myFolder = ActiveWorkbook.Path
'    'myFolder = "D:\bk\office\"
''エクスプローラの起動（Windows2000 C:\WINNT WindowsXP C:\Windows)
'    Shell "C:\WINNT\Explorer.exe " & myFolder, vbNormalFocus
'
End Sub

Private Sub CommandButton1_Click()
'選択テキストからマクロ名を調べてVBEで開く
On Error Resume Next
Dim strText As String
Dim strL, i, endP As Integer

'リストボックスから文字列を取得
    strText = ListBox1.Text
'取得した文字列からプロシージャ名を取り出す
    strL = Len(strText)      'モジュール名＋vbTab+プロシージャ名
        For i = 1 To strL
            If Mid(strText, i, 1) = vbTab Then endP = i
        Next i
    strText = Right(strText, strL - endP)
'マクロ名からVBEへ移動
    Workbooks("PERSONAL.xls").Activate

    Application.Goto Reference:=strText 'プロシージャ名を指定してVBEに移動

End Sub

Private Sub CommandButton2_Click()
'フォームを閉じる
Unload Me
End Sub

タグ：Excel2000 VBA

2011-08-31 12:00 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

アクティブブックのプロシージャ一覧を表示し選択してVBEを開く、コードを出力する実験　Excel2000 VBA　[Excel2000 VBA独習]

アクティブブックのプロシージャ一覧を表示し選択してVBEを開く、コードを出力する実験

Excel2002以降は「Visual Basicプロジェクトへのアクセスを信頼する」チェックボックスをオンにする。
　http://officetanaka.net/excel/vba/vbe/01.htm 　参照

ユーザフォームのリストボックスにモジュール名、プロシージャ一覧を表示し、選択したモジュールをテキスト出力しエクスプローラを開く。
同様にプロシージャ名からVBEを開く。

作成するユーザーフォーム

Sub workbookのプロシージャ一覧()

'ユーザーフォームのリストボックスに
'アクティブブックのプロシージャ名一覧を表示
'プロシージャを選択してVBEを起動
'事前にユーザーフォームを作成
'参考にしたサイト
'http://www.officetanaka.net/excel/vba/vbe/05.htm

On Local Error Resume Next 'エラーが出るのでエラーが出ても実行
    Dim buf, book_name As String
    Dim procNames(100) As String
    Dim i, j, p, cou As Long
    Dim x As Long
    Dim moduleName, z As Variant
    Dim mN(20) As String
    Dim VBcop_count As Integer
    Dim moji, moji_1 As Variant

'Workbookのモジュール数を調べる　数が合わないような・・・
    VBcop_count = ActiveWorkbook.VBProject.VBComponents.Count

'モジュール名取得
    For Each moduleName In ActiveWorkbook.VBProject.VBComponents
        If (moduleName.Type = 1 Or moduleName.Type = 2) And moduleName.Name <> "VBE" Then
        i = i + 1
        mN(i) = moduleName.Name
        'Debug.Print mN(i)
    End If
Next

'プロシージャ名取得
    For x = 1 To VBcop_count

        With ActiveWorkbook.VBProject.VBComponents(mN(x)).CodeModule
            ' Debug.Print mN(x)
            For i = 1 To .CountOfLines
                If buf <> .ProcOfLine(i, 0) Then
                buf = .ProcOfLine(i, 0)
                procNames(j) = mN(x) & vbTab & buf
                'Debug.Print procNames(j)
                j = j + 1
                cou = cou + 1 'プロシージャ数
                End If
            Next i
        End With
    Next x

'---- フォームにプロシージャ一覧を表示 ----

'一行目に項目名を設定
    UserForm3.ListBox1.AddItem ActiveWorkbook.Name
    UserForm3.ListBox1.AddItem " "
    UserForm3.ListBox1.AddItem "モジュール名　　プロシージャ名"
    UserForm3.ListBox1.AddItem " "
        For i = 1 To cou
            UserForm3.ListBox1.AddItem procNames(i)
            UserForm3.ListBox1.AddItem " "
        Next i
'フォーム表示
    UserForm3.Show vbModeless

End Sub

ボタン１（選択マクロの編集）が押されたら

Private Sub CommandButton1_Click()
'選択テキストからマクロ名を調べてVBEで開く
On Error Resume Next
Dim strText, book_name As String
Dim strL, i, endP As Integer
    strText = ListBox1.text
    strL = Len(strText)
For i = 1 To strL
    If Mid(strText, i, 1) = vbTab Then endP = i
Next i
    strText = Right(strText, strL - endP)
'マクロ名からVBEへ移動
'UserForm3.Hide
book_name = ActiveWorkbook.Name
Workbooks(book_name).Activate

Application.Goto Reference:=strText

End Sub

ボタン２（終了）が押されたら

Private Sub CommandButton2_Click()
Unload Me
End Sub

ボタン３（選択モジュールをTEXT出力）が押されたら

Private Sub CommandButton3_Click()
'リストボックスで取得したモジュールないコードをTEXT出力
'
On Error Resume Next
Dim strText, book_name, saveD, moduleName As String
Dim strL, i, endP As Integer
Dim MyCodeModule As Object

'選択文字列を取得
    strText = ListBox1.text     'モジュール名+vbTab+プロシージャ名
    strL = Len(strText)
    For i = 1 To strL
        If Mid(strText, i, 1) = vbTab Then endP = i: Exit For
    Next i
'vbTabの位置から左側を取得（モジュール名）-1はvbTABを含まないように
    moduleName = Left(strText, endP - 1)

'モジュール名からモジュール内のコードをTEXT出力
    Open ActiveWorkbook.Name & moduleName & ".txt" For Output As #1
    Set MyCodeModule = ActiveWorkbook.VBProject.VBComponents(moduleName).CodeModule
        If MyCodeModule = "" Then MsgBox "モジュールを取得できませんでした。": Exit Sub
    For i = 1 To MyCodeModule.CountOfLines
         saveD = saveD & MyCodeModule.Lines(i, 1) & vbCrLf
         'Debug.Print saveD
    Next i

    Print #1, saveD
    Close #1
    Set MyCodeModule = Nothing
    MsgBox "完了"
'ファイルを開く
Dim WSH
    Dim URL As String
    Set WSH = CreateObject("Wscript.Shell")
    WSH.Run ActiveWorkbook.Name & moduleName & ".txt"
    Set WSH = Nothing
'エクスプローラを開く
Dim myFolder As String
'フォルダの設定
    myFolder = ActiveWorkbook.Path
    'myFolder = "D:\bk\office\"
'エクスプローラの起動（Windows2000 C:\WINNT WindowsXP C:\Windows)
    Shell "C:\WINNT\Explorer.exe " & myFolder, vbNormalFocus

End Sub

2011-08-31 08:07 nice!(0) コメント(0) トラックバック(0)
共通テーマ：パソコン・インターネット

前の16件 | 次の16件 Excel2000 VBA独習ブログトップ

10年遅れの１年生

カレンダー

月別表示

タグクラウド

お気に入り　フリーソフト

Telstar さん

counter

Excel2000VBA 東京電力jukyu-j.csvを取り込む　 [Excel2000 VBA独習]

Excel2000 xlstartフォルダとExcel.xlb を他のPCにコピーした時の問題点　 [Excel2000 VBA独習]

Excel VBA FTPでファイルを送信する実験　Excel2000 VBA　[Excel2000 VBA独習]

ユーザー定義関数をアドインにする　実験　Excl2000 VBA　[Excel2000 VBA独習]

VBA 右クリックメニュー追加、サブメニュー有り　Excel2000 VBA　[Excel2000 VBA独習]

シートイベントの有効無効と状態をステータスバーに表示　Excel2000 VBA　[Excel2000 VBA独習]

InputBoxで設定した範囲だけ選択出来るようにする（シートにマクロ自動設定）　Excel2000 VBA　[Excel2000 VBA独習]

シートの数式を保護（選択出来ないようにする）コードをシートに追記するマクロ　Excel2000 VBA　[Excel2000 VBA独習]

アクティブシートモジュールにコードを挿入する実験　Excel2000 VBA　[Excel2000 VBA独習]

設定した名前つきセルだけ選択(入力)できるようにする実験　Excel2000 VBA　[Excel2000 VBA独習]

今日の日付の行だけ入力出来るようにする実験　Excel2000 VBA　[Excel2000 VBA独習]

設定した範囲だけ入力出来るようにする実験　Excel2000 VBA　[Excel2000 VBA独習]

So-netブログ投稿日からハイパーリンクを作成する実験　Excel2000 VBA　[Excel2000 VBA独習]

ワークシートイベントで数式、指定文字列の保護（セル結合がある場合）の実験 Excel2000 VBA　[Excel2000 VBA独習]

PERSONAL.XLSのプロシージャ一覧を表示選択しVBEを開く,モジュールコードを出力する実験 Excel2000 VBA　[Excel2000 VBA独習]

アクティブブックのプロシージャ一覧を表示し選択してVBEを開く、コードを出力する実験　Excel2000 VBA　[Excel2000 VBA独習]

まいぶろぐ

過去記事一覧

検索ボックス

マイカテゴリー

最新記事一覧

最近のコメント

Telstar さんの記事をnice!と思った人 (全15人)

Telstar さんがnice!と思った記事

Telstar さんがコメントした記事

カレンダー

月別表示

タグクラウド

お気に入り フリーソフト

Telstar さん

counter

まいぶろぐ

過去記事一覧

検索ボックス

マイカテゴリー

最新記事一覧

最近のコメント

Telstar さんの記事をnice!と思った人 (全15人)

Telstar さんがnice!と思った記事

Telstar さんがコメントした記事

お気に入り　フリーソフト