Quantcast
Channel: 日曜大工、DIY、Excel VBAのページ
Viewing all 83 articles
Browse latest View live

Excelファイルから「名前の定義」を削除するマクロ

$
0
0
「名前の定義」を削除するマクロ  [Excelから名前の定義を削除するマクロ]


多くの人が気が付いてないのですが、Excelファイルが無駄で役に立たない情報を溜め込んでいる場合があります。
その一つに、「名前の定義」があります。

●確認方法は
1)ファイルを開ける
2)挿入 → 名前 → 定義
で確認できます。
イメージ 1


身に覚えの無い名前が定義されていたら要注意です。

さらに正確に言うと、この方法では人間が見ることができない「名前」が存在するのです。
しかも、このような「名前」は無駄に存在しています。
この結果、ファイル容量は無駄に大きくなり、パソコンの処理能力を無駄に消費してしまう。悪いことばかりです。

このような無駄な名前が存在してたとしても、少ない個数であれば実害は無く、またあなたが気付くことは無いでしょう。しかしだんだん多くなると、あなたはおかしいと思うはずです。


●なぜこのような悪いファイルが発生してしまったかについて説明します。
ややこしいので説明しませんが、「名前の定義」の使い方を知らない人が普通にExcelを使っていると発生する可能性があります。
また、発見しづらい「名前」を意図的に作ることもできます。けっこう簡単にできます。スクリプトではないプログラミング言語たとえばC言語でプログラムを作る程度の知識があればできます。
だからここでは具体的な方法は説明しません。


●どうやって感染していくかについて説明します。
感染したファイルを流用する場合と、シートをコピーする場合に感染します。さらに、名前が定義されている図形やグラフ、セルをコピーしても感染します。


●以上で説明した悪い「名前の定義」を削除するマクロはここ↓からダウンロードできます。
ダウンロードしたら、パソコンにコピーしてから、開き直してください。そうすれば機能します。


ファイルopenを楽にする

$
0
0

参照したいExcelファイルが開いてなければ前回置いてあったフォルダーに行く

参照したいファイル名(*.xls)を開くと、このファイル名がThisWorkbook.Sheets("初期値").Cells(2, 2)に書き込まれます。またフォルダー名がThisWorkbook.Sheets("初期値").Cells(3, 2)に書き込まれます。
次回からはこのフォルダーからファイル選択画面が開きます。
このためファイルを一度開くと次回から開くのが楽になります。
 
下記のコードは、顧客リストを開く例です。
 

Dim wb As Workbook
Dim blnFlag As Boolean
Dim shSyokiti As Object
Dim PathDB As String
Dim tempDir As String
Dim flag As Boolean
 
Set shSyokiti = ThisWorkbook.Sheets("初期値")
Application.StatusBar = "必要なファイルを開きます"
For Each wb In Workbooks
    If wb.Name = Trim(shSyokiti.Cells(2, 2))  Then
        flag = True
    End If
Next wb
 
If flag = True Then
    'MsgBox "顧客リストはすでに開いています。", vbInformation
Else
    'カレントフォルダーを初期値指定コーナーに記録されているフォルダーに移す
    On Error Resume Next
    PathDB = shSyokiti.Cells(3, 2)
   
    'GetOpenFilenameのためにカレントフォルダーを出力データベースファイルの存在するフォルダーに移す
    'http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_140.html
    If PathDB <> "" And Left(PathDB, 2) <> "\\" Then    'ネットワークで無いフォルダーにカレントを移す
        ChDrive PathDB
        ChDir PathDB
   
    ElseIf Len(PathDB) >= 5 And Left(PathDB, 2) = "\\" Then    'ネットワークにカレントフォルダーを移す
            CreateObject("WScript.Shell").CurrentDirectory = PathDB
    End If
    On Error GoTo 0
   
    MsgBox "顧客リストをこれから開きます", vbInformation
    '顧客リストのファイルを指定する
    tempDir = Application.GetOpenFilename("顧客リスト(*.xls),*.xls", Title:="顧客リストのファイルを指定")
   
    If tempDir = "False" Then
        MsgBox "ファイルが指定されませんでしたので終了します。"
        End
    End If
   
    '顧客リストのファイルを開く
    Application.Workbooks.Open (tempDir)
    PathDB = ActiveWorkbook.Path
    
    '顧客リストのファイルのPathを初期値指定コーナーに記録
    '次回、楽に開くため
    shSyokiti.Cells(3, 2) = PathDB
    shSyokiti.Cells(2, 2) = ActiveWorkbook.name
End If
 
'カレントフォルダーを本ファイルのある場所に移す
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

すべてのブックを非表示から表示に変更する

$
0
0

開いているブックのシートをすべて表示させる

 
用途:VBAがシートを非表示にしたため不要なシートを削除できないことがあります。そこですべてのシートを表示させたい。
 

Dim sh As Object
Dim wb As Object
 
For Each wb In Workbooks
  For Each sh In wbook.Sheets
   sh.Visible = True
  Next
Next

ソートしてから重複行を削除

$
0
0

ソートして、ついでに重複行を削除

用途:ソートと同時に重複行を削除したい場面がときどきあります。このときに使うVBAです。
 
下記コードの説明:
 データがA、B列に記入されています。2列だけです。
 まずこれらA、B列でソートします。
 A列が優先されます。
 次に、重複した行を削除した状態で、C、D列にペーストします。
    AdvancedFilter     Unique:=True
 最後に。A、B列を削除します。
 すると、ソートし、しかも重複行が削除されたデータと置き換わります。
 
Range("A1").CurrentRegion.Sort _
Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin
 
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("C1"), Unique:=True
Columns("A:B").Delete
Columns("A:B").EntireColumn.AutoFit         '列幅を自動調整
 

セル内の改行コードを削除

$
0
0

セル内の改行コードを削除

Excelでは改行コードが2種類混在している。だから下記のコードのように2行ともに実行する必要がある。
 
使う場面: セルに記入されている文字列を取得する。
このときセル内で改行されていると改行コードが混じってしまう。そこでこの改行コードを削除したい。

 .Cells(tempRow, tempCol) = Replace(.Cells(tempRow, tempCol), vbCrLf, "")
 .Cells(tempRow, tempCol) = Replace(.Cells(tempRow, tempCol), vbLf, "")
 

 
参考文献:  ttp://officetanaka.net/excel/vba/tips/tips89.htm

日時をシリアルから文字列に変換

$
0
0

日時をシリアルから文字列に変換

使う場面:Excelで使用される日時は、実態は実数でありシリアルと呼ばれている。MS Office内 でコピーするなら余分なことを考える必要は無い。ところが違うアプリにコピーする場合は一度文字列に変換するのが汎用的な方法である。
 

 
strNengappi = Year(.Cells(2,2) & "/" & Month(.Cells(2,2)) & _
      "/" & Day(.Cells(2,2)) & "/" & Hour(.Cells(2,2)) & _
      ":" & Minute(.Cells(2,2))

サブフォルダ名をリストアップする

$
0
0

指定するフォルダのサブフォルダ名をすべてリストアップする

用途: 指定したフォルダーとサブフォルダーを含めて特定のファイルを探す
 
下記コードは、サブフォルダー、さらにこのサブフォルダー、さらに・・・と何層でもどんどん深いサブフォルダーを自動的に探します。
 

Sub sFolderSearch(ByVal strSFName0 As String, ByVal ShN As String)
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim strSFName As Variant
    Dim FSO As Object
    Dim Row As Long
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = Fso.GetFolder(strSFName0)
       
    With myFolder
        If .SubFolders.Count > 0 Then
            For Each mySubFolder In .SubFolders
                '見つかったサブフォルダを書き込む
                strSFName = strSFName0 & "\" & mySubFolder.Name
                Row = ThisWorkbook.Sheets(ShN).Cells(65536, 1).End(xlUp).Offset(1, 0).Row
                ThisWorkbook.Sheets(ShN).Cells(Row, 1) = strSFName
                Row = Row + 1
                If Row > 1001 Then     'サブフォルダーの個数が1000個を超えたら強制終了
                    End
                End If
                '再帰的に関数を呼び出し
                Call sFolderSearch(strSFName, ShN)
            Next
        End If
    End With
 
    Set FSO = Nothing

End Sub

周期的に実行するタイマー

$
0
0

周期的に実行するタイマー

動作:周期的にマクロ Keisan  を動作させます。
    .Cells(2, 2)に60以上の整数を記入すると次回の実行を中止(Exit Sub)する
 
使い方:
.Cells(2, 2)にminuteを表す整数を入れておく。
下記コードをプロシジャー(マクロ) Keisan に記入する。
 
使う場面: 別のファイルからデータをコピーしデータ分析する。これを10分ごとに繰り返す。



TimePiriod = Trim(Thisworkbook.Sheets(1).Cells(2, 2))
If TimePiriod >= 60 Then
    MsgBox "自動運転モードを終了します"
    DTTimeStart = 0
    Exit Sub
End If
DTTimeStart = Now + TimeValue("00:" & TimePiriod & ":00")
Application.OnTime DTTimeStart, "Keisan"
 



'次の実行サイクルを待たずに、すぐに中止させるには下記マクロ
'を実行する
Sub teisi()
Thisworkbook.Sheets(1).Cells(2, 2) = 999
On Error Resume Next
Application.OnTime DTTimeStart, "Keisan", , False
On Error GoTo 0
End Sub

グラフにデータラベルを付ける

$
0
0

グラフにデータラベルを付ける

手動でグラフを描画し、このプロットごとにラベルを付けようとすると苦労します。
ところがVBAを利用するとプロット一つづつに任意の文字列を自由にラベルに付けられます。ラベルを表示する位置も指定できます。
 
下記はこのコード例です。
 

    With ActiveChart.SeriesCollection(1).Points
        For i = 2 To LastRow - 2
            'ラベルとして表示する文字列を取得する
            strLabel = Workbooks(GraphBookName).Sheets("graph").Cells(2, 2)
            With .Item(i - 1)         ' Itemとはプロットのこと
                  .HasDataLabel = True 'データラベルを表示します
                  .dataLabel.Text = strLabel '任意の文字列をラベルにできる
                  .dataLabel.Interior.Color = QBColor(11)
                  .dataLabel.Font.Size = 12 'Fontサイズ変更
                  .dataLabel.Top = .dataLabel.Top + 50  'ラベルの表示位置指定
                  .Border.LineStyle = xlDash '枠線種類指定
            End With
        Next i
    End With

互換性のあるグラフの描き方

$
0
0
グラフを描くVBAは互換性が低く、悪いです。このため複雑なコーディングをすると、自分のPCでは何ら問題なくグラフを描いてくれるのに、別のPCでは動かないことがあります。けっこうあります。
症状はいろいろです。例えば、真っ白な枠だけしか描かれない場合や、グラフの折れ線を中途半端にしか描かない場合などがあります。
 
 
そこで参考となる情報をまとめました。
 
さて、互換性には種類があります。
・Excelのバージョンによる違い。
・Excelのバージョンは同じなのにPCが違うと動いたり動かなかったり。
・PCもExcelのバージョンも同じなのにデータが違うと動いたり動かなかったり。
 
★ 予備知識
まずはオブジェクトの階層構造を頭に入れておきます。これを知るとモヤモヤが消えてすっきりします。
 
Sheetオブジェクト
  |
  ChartObjectオブジェクト ・・・ グラフの枠=長方形の白い台紙。   .name を取得も設定もできる
    |
    Chartオブジェクト ・・・ グラフそのもの。     .name は取得だけできる
 
 
■ Excelバージョン間の互換性
このサイトOfficeTANAKAによると、Chartの名前はExcelのバージョンによって違うと書いてあります。 
     Excel2003 → ブック名 と通し番号
     Excel2010 → シート名 と通し番号
 
またこの本家マイクロソフトのサイトによるとVisual Studio 2010では次のように書かれています。
Chart コントロールを作成すると、Excel は Name プロパティを sheetname Chart n" と言う文字列に設定します (n はワークシート上の埋め込みグラフの数)。 たとえば、Chart を Sheet1 に追加し、それがワークシートの最初の埋め込みグラフの場合は、Name プロパティの値は Sheet1 グラフ 1になります。
Name プロパティは読み取り専用ですが、親 Microsoft.Office.Interop.Excel.ChartObject の Name プロパティを使用して名前の一部を変更することができます。 指定した新しい名前で、Name プロパティによって返される文字列の "Chart n" 部分が置き換わります。 たとえば、次のコードは、Chart コントロールのName プロパティ値を Sheet1 グラフ 1 から Sheet1 SalesChart に変更します。
本家の解説は難しい。私は疲れているときには読む気力が湧きません。
 
さて、どっちなんだろう?  chart.name を構成するのは、シート名 なのか ブック名なのか?
そこで実証しました。Excelのバージョンは、Excel2003と 2010 です。
この実験を始める前に、シート名は、「graph」に設定しておきました。
 
コード1
    .ChartObjects.Add(gX, gY, gSizeX, gSizeY).Name = strID
        With .ChartObjects( strID).Chart
            tempstr = .Name
            '''''tempstr = Replace(tempstr, "graph ", "")
           .ChartType = xlXYScatterLines
           .SetSourceData Source:=rngByouga, PlotBy:=xlColumns
           .Location Where:=xlLocationAsObject, Name:="graph"
            .HasTitle = True
             ・・・
 
この実験の結果、tempstrは、Excel2003 と 2010 いずれの場合もシート名と strIDの結合された文字列でした。
 
 
 
コード2
    .ChartObjects.Add(gX, gY, gSizeX, gSizeY).Select
        Selection.Activate
        With ActiveChart
           tempstr = .Name
           .ChartType = xlXYScatterLines
           .SetSourceData Source:=rngByouga, PlotBy:=xlColumns
           .Location Where:=xlLocationAsObject, Name:="graph"
            .HasTitle = True
             ・・・
 
この実験の結果、tempstrは、Excel2003 と 2010 いずれの場合もシート名と "グラフ 1"の結合された文字列でした。
 
 
というわけで、
Chart.nameは、Excel2003 と 2010 いずれの場合もシート名と "グラフ 1"または設定した文字列の結合です。
 
しかし念のため、コーディングの後に、労力を惜しまず両方のバージョンで実証試験するのが安心です。
 
 
■ パソコン間の互換性
パソコン間で互換性が無い原因はメモリー不足によるものと推定しています。
ですから、グラフを描くもとになるデータセットが小さい場合や、グラフの個数が少ない場合はパソコン間の互換性はあります。
バグが発生しやすい状況は、
 ・データが大きい場合
 ・グラフを描くコードを実行するまでに、大きいコードを処理していて、メモリーを消費している場合
 
いろいろ試行錯誤した結果、たいていのパソコンで動くコードが見つかりました。このサイトに詳しく書かれているコードです。
コードの説明: ChartObjectsをAddで作って、名前を付けておきます。そして、各種プロパティーを設定するために名前で呼び出します。このやり方が一番確実に動くコードでした。消費するメモリーが少ないのだと思います。 
Sub sample1()

Dim myRange As Range
Set myRange = Range("A1:D2")

Worksheets("Sheet1").ChartObjects.Add(50, 50, 300, 200).Name = "グラフの名前"

With ActiveSheet.ChartObjects("グラフの名前").Chart
.ChartType = xlPie
.SetSourceData Source:=myRange, PlotBy:=xlRows
.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent, LegendKey:=False, HasLeaderLines:=True
End With

End Sub
 
同じサイトに紹介されている次のコードは搭載しているメモリーが少ないPCでは動かないことがありました。
Sub sample()

Dim myRange As Range
Set myRange = Range("A1:D2")

With Worksheets("Sheet1").ChartObjects.Add(50, 50, 300, 200).Chart
.ChartType = xlPie
.SetSourceData Source:=myRange, PlotBy:=xlRows
.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent, LegendKey:=False, HasLeaderLines:=True
End With

End Sub
 
パソコン間の依存性がさらに発生しやすいコードはこれ↓です。メモリーが1GBのパソコンでは動きましたが、512MBのパソコンでは動かない場合がありました。
     ActiveSheet.ChartObjects.Add(25, 125, 338, 220).Select
この例に限らず、VBAすべてに言えることですが、 .select はメモリー消費が多いようです。
 
一般的に言われていることですが、activate や select 文はできるだけ使わないのがエレガントなプログラムです。私の経験ではこれらを使うと勘違いすることによるバグが多発します。つまり、コードが長くなるとactivateされたシートを見失ってしまい勘違いしてしまうのです。selectも同じです。記録マクロで生成されたコードはactivateやselectがたくさん入ってますが、これを修正しておいた方がいいです。
 
パソコン間の依存性を減らす別の方法は、Excel2003からExcel2010に変えて、しかもメモリーをたっぷり積むことです。 たとえば1GB以上。仕事で使うなら、プログラミングに余分な神経と労働時間をかけるよりも経済的だと思います。  
Excel2003よりもExcel2010はメモリーの使い方が工夫されていますので、同じPCでもバグが発生しにくいです。つまりグラフを描かなかったり、中途半端にしか描かないというバグが発生しにくいです。 
 
 
● 参考web
 
EXCEL VBA:埋め込みグラフオブジェクトの命名方法について
 
VBA便利帳
 
Office TANAKA
グラフの名前を設定/取得する
 
グラフを削除する バージョン依存性がある
 
 
 
VBAからの自動グラフ作成でのエラー
  どうしても原因が不明の時はこれかもしれません。こんな技は特殊すぎて思いつかないですね。 
  どんなやり方かというと、Excelファイルを開けるとき「マクロを無効」にして開ける。そしてそのまま上書き保存。
  この簡単な操作によって、マクロを動作させるときに使用されるワーキング領域にたまってしまっていたゴミ
  を掃除できる・・・と説明されてます。
 
ワークシートにグラフを挿入する
 

ファイルopenを楽にする

$
0
0

参照したいExcelファイルが開いてなければ前回置いてあったフォルダーに行く

参照したいファイル名(*.xls)を開くと、このファイル名がThisWorkbook.Sheets("初期値").Cells(2, 2)に書き込まれます。またフォルダー名がThisWorkbook.Sheets("初期値").Cells(3, 2)に書き込まれます。
次回からはこのフォルダーからファイル選択画面が開きます。
このためファイルを一度開くと次回から開くのが楽になります。
 
下記のコードは、顧客リストを開く例です。
 

Dim wb As Workbook
Dim blnFlag As Boolean
Dim shSyokiti As Object
Dim PathDB As String
Dim tempDir As String
Dim flag As Boolean
 
Set shSyokiti = ThisWorkbook.Sheets("初期値")
Application.StatusBar = "必要なファイルを開きます"
For Each wb In Workbooks
    If wb.Name = Trim(shSyokiti.Cells(2, 2))  Then
        flag = True
    End If
Next wb
 
If flag = True Then
    'MsgBox "顧客リストはすでに開いています。", vbInformation
Else
    'カレントフォルダーを初期値指定コーナーに記録されているフォルダーに移す
    On Error Resume Next
    PathDB = shSyokiti.Cells(3, 2)
   
    'GetOpenFilenameのためにカレントフォルダーを出力データベースファイルの存在するフォルダーに移す
    'http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_140.html
    If PathDB <> "" And Left(PathDB, 2) <> "\\" Then    'ネットワークで無いフォルダーにカレントを移す
        ChDrive PathDB
        ChDir PathDB
   
    ElseIf Len(PathDB) >= 5 And Left(PathDB, 2) = "\\" Then    'ネットワークにカレントフォルダーを移す
            CreateObject("WScript.Shell").CurrentDirectory = PathDB
    End If
    On Error GoTo 0
   
    MsgBox "顧客リストをこれから開きます", vbInformation
    '顧客リストのファイルを指定する
    tempDir = Application.GetOpenFilename("顧客リスト(*.xls),*.xls", Title:="顧客リストのファイルを指定")
   
    If tempDir = "False" Then
        MsgBox "ファイルが指定されませんでしたので終了します。"
        End
    End If
   
    '顧客リストのファイルを開く
    Application.Workbooks.Open (tempDir)
    PathDB = ActiveWorkbook.Path
    
    '顧客リストのファイルのPathを初期値指定コーナーに記録
    '次回、楽に開くため
    shSyokiti.Cells(3, 2) = PathDB
    shSyokiti.Cells(2, 2) = ActiveWorkbook.name
End If
 
'カレントフォルダーを本ファイルのある場所に移す
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

すべてのブックを非表示から表示に変更する

$
0
0

開いているブックのシートをすべて表示させる

 
用途:VBAがシートを非表示にしたため不要なシートを削除できないことがあります。そこですべてのシートを表示させたい。
 

Dim sh As Object
Dim wb As Object
 
For Each wb In Workbooks
  For Each sh In wbook.Sheets
   sh.Visible = True
  Next
Next

ソートしてから重複行を削除

$
0
0

ソートして、ついでに重複行を削除

用途:ソートと同時に重複行を削除したい場面がときどきあります。このときに使うVBAです。
 
下記コードの説明:
 データがA、B列に記入されています。2列だけです。
 まずこれらA、B列でソートします。
 A列が優先されます。
 次に、重複した行を削除した状態で、C、D列にペーストします。
    AdvancedFilter     Unique:=True
 最後に。A、B列を削除します。
 すると、ソートし、しかも重複行が削除されたデータと置き換わります。
 
Range("A1").CurrentRegion.Sort _
Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin
 
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("C1"), Unique:=True
Columns("A:B").Delete
Columns("A:B").EntireColumn.AutoFit         '列幅を自動調整
 

セル内の改行コードを削除

$
0
0

セル内の改行コードを削除

Excelでは改行コードが2種類混在している。だから下記のコードのように2行ともに実行する必要がある。
 
使う場面: セルに記入されている文字列を取得する。
このときセル内で改行されていると改行コードが混じってしまう。そこでこの改行コードを削除したい。

 .Cells(tempRow, tempCol) = Replace(.Cells(tempRow, tempCol), vbCrLf, "")
 .Cells(tempRow, tempCol) = Replace(.Cells(tempRow, tempCol), vbLf, "")
 

 
参考文献:  ttp://officetanaka.net/excel/vba/tips/tips89.htm

日時をシリアルから文字列に変換

$
0
0

日時をシリアルから文字列に変換

使う場面:Excelで使用される日時は、実態は実数でありシリアルと呼ばれている。MS Office内 でコピーするなら余分なことを考える必要は無い。ところが違うアプリにコピーする場合は一度文字列に変換するのが汎用的な方法である。
 

 
strNengappi = Year(.Cells(2,2) & "/" & Month(.Cells(2,2)) & _
      "/" & Day(.Cells(2,2)) & "/" & Hour(.Cells(2,2)) & _
      ":" & Minute(.Cells(2,2))

サブフォルダ名をリストアップする

$
0
0

指定するフォルダのサブフォルダ名をすべてリストアップする

用途: 指定したフォルダーとサブフォルダーを含めて特定のファイルを探す
 
下記コードは、サブフォルダー、さらにこのサブフォルダー、さらに・・・と何層でもどんどん深いサブフォルダーを自動的に探します。
 

Sub sFolderSearch(ByVal strSFName0 As String, ByVal ShN As String)
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim strSFName As Variant
    Dim FSO As Object
    Dim Row As Long
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = Fso.GetFolder(strSFName0)
       
    With myFolder
        If .SubFolders.Count > 0 Then
            For Each mySubFolder In .SubFolders
                '見つかったサブフォルダを書き込む
                strSFName = strSFName0 & "\" & mySubFolder.Name
                Row = ThisWorkbook.Sheets(ShN).Cells(65536, 1).End(xlUp).Offset(1, 0).Row
                ThisWorkbook.Sheets(ShN).Cells(Row, 1) = strSFName
                Row = Row + 1
                If Row > 1001 Then     'サブフォルダーの個数が1000個を超えたら強制終了
                    End
                End If
                '再帰的に関数を呼び出し
                Call sFolderSearch(strSFName, ShN)
            Next
        End If
    End With
 
    Set FSO = Nothing

End Sub

周期的に実行するタイマー

$
0
0

周期的に実行するタイマー

動作:周期的にマクロ Keisan  を動作させます。
    .Cells(2, 2)に60以上の整数を記入すると次回の実行を中止(Exit Sub)する
 
使い方:
.Cells(2, 2)にminuteを表す整数を入れておく。
下記コードをプロシジャー(マクロ) Keisan に記入する。
 
使う場面: 別のファイルからデータをコピーしデータ分析する。これを10分ごとに繰り返す。



TimePiriod = Trim(Thisworkbook.Sheets(1).Cells(2, 2))
If TimePiriod >= 60 Then
    MsgBox "自動運転モードを終了します"
    DTTimeStart = 0
    Exit Sub
End If
DTTimeStart = Now + TimeValue("00:" & TimePiriod & ":00")
Application.OnTime DTTimeStart, "Keisan"
 



'次の実行サイクルを待たずに、すぐに中止させるには下記マクロ
'を実行する
Sub teisi()
Thisworkbook.Sheets(1).Cells(2, 2) = 999
On Error Resume Next
Application.OnTime DTTimeStart, "Keisan", , False
On Error GoTo 0
End Sub

グラフにデータラベルを付ける

$
0
0

グラフにデータラベルを付ける

手動でグラフを描画し、このプロットごとにラベルを付けようとすると苦労します。
ところがVBAを利用するとプロット一つづつに任意の文字列を自由にラベルに付けられます。ラベルを表示する位置も指定できます。
 
下記はこのコード例です。
 

    With ActiveChart.SeriesCollection(1).Points
        For i = 2 To LastRow - 2
            'ラベルとして表示する文字列を取得する
            strLabel = Workbooks(GraphBookName).Sheets("graph").Cells(2, 2)
            With .Item(i - 1)         ' Itemとはプロットのこと
                  .HasDataLabel = True 'データラベルを表示します
                  .dataLabel.Text = strLabel '任意の文字列をラベルにできる
                  .dataLabel.Interior.Color = QBColor(11)
                  .dataLabel.Font.Size = 12 'Fontサイズ変更
                  .dataLabel.Top = .dataLabel.Top + 50  'ラベルの表示位置指定
                  .Border.LineStyle = xlDash '枠線種類指定
            End With
        Next i
    End With

互換性のあるグラフの描き方

$
0
0
グラフを描くVBAは互換性が低く、悪いです。このため複雑なコーディングをすると、自分のPCでは何ら問題なくグラフを描いてくれるのに、別のPCでは動かないことがあります。けっこうあります。
症状はいろいろです。例えば、真っ白な枠だけしか描かれない場合や、グラフの折れ線を中途半端にしか描かない場合などがあります。
 
 
そこで参考となる情報をまとめました。
 
さて、互換性には種類があります。
・Excelのバージョンによる違い。
・Excelのバージョンは同じなのにPCが違うと動いたり動かなかったり。
・PCもExcelのバージョンも同じなのにデータが違うと動いたり動かなかったり。
 
★ 予備知識
まずはオブジェクトの階層構造を頭に入れておきます。これを知るとモヤモヤが消えてすっきりします。
 
Sheetオブジェクト
  |
  ChartObjectオブジェクト ・・・ グラフの枠=長方形の白い台紙。   .name を取得も設定もできる
    |
    Chartオブジェクト ・・・ グラフそのもの。     .name は取得だけできる
 
 
■ Excelバージョン間の互換性
このサイトOfficeTANAKAによると、Chartの名前はExcelのバージョンによって違うと書いてあります。 
     Excel2003 → ブック名 と通し番号
     Excel2010 → シート名 と通し番号
 
またこの本家マイクロソフトのサイトによるとVisual Studio 2010では次のように書かれています。
Chart コントロールを作成すると、Excel は Name プロパティを sheetname Chart n" と言う文字列に設定します (n はワークシート上の埋め込みグラフの数)。 たとえば、Chart を Sheet1 に追加し、それがワークシートの最初の埋め込みグラフの場合は、Name プロパティの値は Sheet1 グラフ 1になります。
Name プロパティは読み取り専用ですが、親 Microsoft.Office.Interop.Excel.ChartObject の Name プロパティを使用して名前の一部を変更することができます。 指定した新しい名前で、Name プロパティによって返される文字列の "Chart n" 部分が置き換わります。 たとえば、次のコードは、Chart コントロールのName プロパティ値を Sheet1 グラフ 1 から Sheet1 SalesChart に変更します。
本家の解説は難しい。私は疲れているときには読む気力が湧きません。
 
さて、どっちなんだろう?  chart.name を構成するのは、シート名 なのか ブック名なのか?
そこで実証しました。Excelのバージョンは、Excel2003と 2010 です。
この実験を始める前に、シート名は、「graph」に設定しておきました。
 
コード1
    .ChartObjects.Add(gX, gY, gSizeX, gSizeY).Name = strID
        With .ChartObjects( strID).Chart
            tempstr = .Name
            '''''tempstr = Replace(tempstr, "graph ", "")
           .ChartType = xlXYScatterLines
           .SetSourceData Source:=rngByouga, PlotBy:=xlColumns
           .Location Where:=xlLocationAsObject, Name:="graph"
            .HasTitle = True
             ・・・
 
この実験の結果、tempstrは、Excel2003 と 2010 いずれの場合もシート名と strIDの結合された文字列でした。
 
 
 
コード2
    .ChartObjects.Add(gX, gY, gSizeX, gSizeY).Select
        Selection.Activate
        With ActiveChart
           tempstr = .Name
           .ChartType = xlXYScatterLines
           .SetSourceData Source:=rngByouga, PlotBy:=xlColumns
           .Location Where:=xlLocationAsObject, Name:="graph"
            .HasTitle = True
             ・・・
 
この実験の結果、tempstrは、Excel2003 と 2010 いずれの場合もシート名と "グラフ 1"の結合された文字列でした。
 
 
というわけで、
Chart.nameは、Excel2003 と 2010 いずれの場合もシート名と "グラフ 1"または設定した文字列の結合です。
 
しかし念のため、コーディングの後に、労力を惜しまず両方のバージョンで実証試験するのが安心です。
 
 
■ パソコン間の互換性
パソコン間で互換性が無い原因はメモリー不足によるものと推定しています。
ですから、グラフを描くもとになるデータセットが小さい場合や、グラフの個数が少ない場合はパソコン間の互換性はあります。
バグが発生しやすい状況は、
 ・データが大きい場合
 ・グラフを描くコードを実行するまでに、大きいコードを処理していて、メモリーを消費している場合
 
いろいろ試行錯誤した結果、たいていのパソコンで動くコードが見つかりました。このサイトに詳しく書かれているコードです。
コードの説明: ChartObjectsをAddで作って、名前を付けておきます。そして、各種プロパティーを設定するために名前で呼び出します。このやり方が一番確実に動くコードでした。消費するメモリーが少ないのだと思います。 
Sub sample1()

Dim myRange As Range
Set myRange = Range("A1:D2")

Worksheets("Sheet1").ChartObjects.Add(50, 50, 300, 200).Name = "グラフの名前"

With ActiveSheet.ChartObjects("グラフの名前").Chart
.ChartType = xlPie
.SetSourceData Source:=myRange, PlotBy:=xlRows
.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent, LegendKey:=False, HasLeaderLines:=True
End With

End Sub
 
同じサイトに紹介されている次のコードは搭載しているメモリーが少ないPCでは動かないことがありました。
Sub sample()

Dim myRange As Range
Set myRange = Range("A1:D2")

With Worksheets("Sheet1").ChartObjects.Add(50, 50, 300, 200).Chart
.ChartType = xlPie
.SetSourceData Source:=myRange, PlotBy:=xlRows
.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent, LegendKey:=False, HasLeaderLines:=True
End With

End Sub
 
パソコン間の依存性がさらに発生しやすいコードはこれ↓です。メモリーが1GBのパソコンでは動きましたが、512MBのパソコンでは動かない場合がありました。
     ActiveSheet.ChartObjects.Add(25, 125, 338, 220).Select
この例に限らず、VBAすべてに言えることですが、 .select はメモリー消費が多いようです。
 
一般的に言われていることですが、activate や select 文はできるだけ使わないのがエレガントなプログラムです。私の経験ではこれらを使うと勘違いすることによるバグが多発します。つまり、コードが長くなるとactivateされたシートを見失ってしまい勘違いしてしまうのです。selectも同じです。記録マクロで生成されたコードはactivateやselectがたくさん入ってますが、これを修正しておいた方がいいです。
 
パソコン間の依存性を減らす別の方法は、Excel2003からExcel2010に変えて、しかもメモリーをたっぷり積むことです。 たとえば1GB以上。仕事で使うなら、プログラミングに余分な神経と労働時間をかけるよりも経済的だと思います。  
Excel2003よりもExcel2010はメモリーの使い方が工夫されていますので、同じPCでもバグが発生しにくいです。つまりグラフを描かなかったり、中途半端にしか描かないというバグが発生しにくいです。 
 
 
● 参考web
 
EXCEL VBA:埋め込みグラフオブジェクトの命名方法について
 
VBA便利帳
 
Office TANAKA
グラフの名前を設定/取得する
 
グラフを削除する バージョン依存性がある
 
 
 
VBAからの自動グラフ作成でのエラー
  どうしても原因が不明の時はこれかもしれません。こんな技は特殊すぎて思いつかないですね。 
  どんなやり方かというと、Excelファイルを開けるとき「マクロを無効」にして開ける。そしてそのまま上書き保存。
  この簡単な操作によって、マクロを動作させるときに使用されるワーキング領域にたまってしまっていたゴミ
  を掃除できる・・・と説明されてます。
 
ワークシートにグラフを挿入する
 

Excel VBAのセキュリティー

$
0
0
Excel  VBAのセキュリティーを上げる方法を3つ書く

1. パスワードを付ける

VB editor で標準モジュールを右クリック

イメージ 1




イメージ 2
























注意: password を見破る手順をネットで検索できる。 だから、プロやマニアに見破られることを覚悟しておこう。 

 
2. VBAを使用できる期限を設定する。 期限を越えるとVBAが動かない。

次のコードを、プロシジャの最初のほうに埋め込んでおけばいい。
Const str_date_expiration As String = "2016/07/31"
int_date_expiration = DateDiff("d", str_date_expiration, Date)
If int_date_expiration > 0 Then
    MsgBox "期限が切れてます。"
    End
End If


3. 外人に使わせない。
遠い国の人は考え方がちがうので怖い。利用者を日本人に限定すればそれだけ安全である。
Excelで使う言語を日本語に設定してあるかまたは、WINDOWSで国の設定が日本ならVBAは動く。
次のコードを、プロシジャの最初のほうに埋め込んでおけばいい。

Dim country As Double
Dim 言語 As Long
country = Application.International(xlCountrySetting)
言語 = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
If country <> 81 And 言語 <> 1041 Then
    End
End If


Viewing all 83 articles
Browse latest View live