忍者ブログ
ブログ主が仕事や個人的に学んだPC系・プログラミング系(VBAとかHTML)について書いていく備忘録ブログ。 ※ここで記載する内容はあくまで「個人的に」上手くいく内容です。ご使用には十分注意してください
[1] [2] [3] [4] [5] [6] [7
Posted by - 2017.05.30,Tue
×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

Posted by 若槻風亜 - 2014.12.09,Tue

(対象)Excel VBA
(確認)Excel2010、2013


今回はExcelでブックを閉じる時の確認動作です。

多分2010からだった気がしますが、2003の時の
閉じ方をすると、中身だけ消えてExcel自体が
残った状態になってしまいます。

でも全部消えるようにすると、複数ブックを
開いている時に困る。


そんな時は以下の通りの判断なんてどうでしょう。

※いらない部分もいくつかあるかもです

―――――――――――――――――――――――――――

<変数>
Dim MSG   As String 
Dim EndFG As Boolean
Dim WB1   As Workbook


<呼び出し>
'============================================
' ブックを閉じる時
'============================================
Sub auto_close()
    CloseThisFile
End Sub
※「auto_close」についてはこちらの記事


<本文>
※今回はExcelのVBAを保存しているファイルである
「PERSONAL.XLS」を含めて指定しています。


'===========================================================
' Excelの終了
'===========================================================
Sub CloseThisFile()
  '■終了の仕方を確認
  MSG = MsgBox("Excelを保存して終了する場合は「はい」を、" & vbCrLf & vbCrLf & _
               "保存しないで終了する場合は「いいえ」を押してください", vbQuestion + vbYesNoCancel, "【終了確認】")
  
  
  '■終了の選択によって閉じ方を変更
  EndFG = False
  If MSG = vbYes Then
    '<保存して閉じる>
    '△開いているのが1つのとき、もしくは2つで片方が「PERSONAL.XLS」の場合は保存してアプリケーションごと閉じる
    '※もうひとつ確実に開いているファイルがない場合はこの条件は前者だけでOK
    '※「BooksCheck」は上のファイルがない場合は不要の処理
    BooksCheck
    If Workbooks.Count = 1 Or (Workbooks.Count = 2 And EndFG) Then ThisWorkbook.Save: Application.Quit
    
    '△それ以外は普通にClose使って閉じる(保存する)
    ThisWorkbook.Close savechanges:=True
    
  ElseIf MSG = vbNo Then
    '<保存しないで閉じる>
    '△開いているのが1つのとき、もしくは2つで片方が「PERSONAL.XLS」の場合はアプリケーションごと閉じる
    BooksCheck
    If Workbooks.Count = 1 Or (Workbooks.Count = 2 And EndFG) Then Application.Quit
    
    '△それ以外は普通にClose使って閉じる(保存しない)
    ThisWorkbook.Close savechanges:=False
  End If
End Sub
※今回は「PERSONAL.XLS」があるかどうか。
確実に同時に開いている他ファイルがない場合は
このプロシージャは不要。

'===========================================================
' ブックの確認
'===========================================================
Sub BooksCheck()
  '■開いているブックをひとつずつ確認
  ' (この例の場合は「PERSONAL.XLS」の有無)
  For Each WB1 In Workbooks
    If WB1.Name = "PERSONAL.XLS" Then EndFG = True: Exit For
  Next
End Sub
―――――――――――――――――――――――――――

こんな感じです。

ちなみに終了確認の時のダイアログはこんな感じ↓



余計な部分もありますが、何か一緒に開いている物がある、
という場合には重宝したりします。(個人的には)


では今回はこの辺りで。

拍手[0回]

PR
Posted by 若槻風亜 - 2014.09.02,Tue

■フリーソフト■
<ソフト名>
 CountDown ~減丸~
 
 
<機能>
 1.指定した目標日付・目標時間までの日付と時間のカウントダウン
 2.設定した日から何日経っているかの表示
 
 
<開発言語>
 VB2010
 
 
<使用用途>
 1.目標日付までのカウントダウン
  (作成者は締め切りまでのカウントダウン用に作りました)
 
 
<プリントスクリーンと各用途>
 1.メイン画面
 
 ※通常サイズ
 
 
 ※設定を開いた状態
 
 
  1)現在日時 → パソコンから取得
  2)目標日付 → 「yyyy/mm/dd」の形式で設定
           (例:2014/05/05、2014/12/15、など)
  3)目標時間 → 特にない場合はそのままでも良し
  4)「設定」ボタン押下
    → 目標日時が決められている場合はカウント開始。
      過去の日付が設定された/変更なしで押した場合は翌日日付を設定
      
      
  
  5)経過日数 → 設定した日から何日経過しているか(設定日が1日目換算)
    
     ※経過観測
     
    
  6)設定を初期化する → 目標日時を初期化する
  7)「機能設定を開く↓/閉じる↑」
    [1]表示形式
      ・日のみ : ○○日
      ・週日  : ■■週間 ○○日
      ・月日  : △△ヶ月 ○○日
      ・年月日 : ××年 △△ヶ月 ○○日
    [2]時間表示
      ・する  : 上の表示に時間をプラス(hh時間 mm分 ss秒
             → 例:20時間 05分 46秒)
      ・しない : 時間を表示しない
    [3]期日を過ぎた後の表示
      ・初期値に戻す    : 「1999/01/01 00時00分00秒」に戻す
      ・マイナス表示にする : 各数字の前にマイナスをつけて表示
      
       
 

<追加 ここから>

1.折りたたみボタン追加。経過日付部分をたためるように
  


<追加 ここまで>

 
<ファイル>
 (クリックするとダウンロードが始まります)
 
 (内容物)
   1.本体(CountDown ~減丸~.exe)
   2.ReadMe_GenMaru.txt
 
 
 (ウィルス検査)
   済み。異常なし
 
 
 (注意1)
   動作には十分注意して作成しましたが、
   ダウンロードして使用する場合は自己責任で
   お願いします。
 
 
 (注意2)
   GoogleChromeでダウンロードしようとすると
   ブラウザの使用上以下のメッセージが出ますが
   その場合は「継続」を押してください
  

#使用していて気になった点あればご報告いただければと思います。
#※完全に直す、とは言い切りませんが。。。
#使用時にエラーが表示された場合は、
# 1.エラー内容
# 2.エラーが表示された時の動作
#を、ご連絡ください


拍手[0回]

Posted by 若槻風亜 - 2014.06.17,Tue
(対象)Excel VBA
(確認)Excel2003(多分2010でも使える)


今回はワークブック内のシートを新しいブックに保存する方法を
書いていこうと思います。

私がこれを使ったのは、たとえば毎日の処理でシートが徐々に
増えていくプログラムなどでした。

なので、今回の流れとしては

「月が替わったら前月のシートを全て新しいブックに移す」

となります。
----------------------------------

(前提)
 1.各対象シートのB1セルに日付が入っている
 2.DontLookやOKLookなどを使用→詳しくはこちら

(プログラム)
  '============================================================
  ' 月ごとにシートの抜き出し
  '============================================================
  Sub Nukidasi()
    Dim I       As Integer
    Dim MyFile  As String
    Dim MyDate  As String
    Dim Moji    As String
    Dim WB1     As WorkBook
    Dim WB2     As WorkBook
    Dim WHX     As WorkSheet

    '■インプットボックスで年月を指定(※1)
    MyDate = InputBox("抜き出すデータの年月を西暦で入力してください(Ex: 201307)", "年月指定")

    '■データが空だったり数字以外だったら処理を抜ける
    If MyDate = "" Then
      MsgBox "入力がされませんでした。処理を中断します", vbExclamation, "【報告】"
       Exit Sub
    ElseIf Not IsNumeric(MyDate) Then '(※2)
      MsgBox "数字以外が入力されました。処理を中断します", vbExclamation, "【報告】"
      Exit Sub
    End If

    '■指定年月に当てはまるものを新しいブックに保存していく
    DontLook

    '1.ブックを設定
    Workbooks.Add
    Set WB1 = ThisWorkbook
    Set WB2 = ActiveWorkbook
    WB1.Activate

    '2.該当のシートを移していく
    I = 1
    Do Until I > ThisWorkbook.Worksheets.Count
      Set WHX = Sheets(I)
      Moji = Replace(Left(WHX.Range("B1").Value, 7), "/", "") '(※3)

      '△指定した年月と一致したら移動する
      If MyDate = Moji Then
        Sheets(I).Move After:=WB2.Sheets(WB2.Worksheets.Count) '(※4)
        WB1.Activate
        I = I - 1 '(※5)
      End If
      I = I + 1
    Loop

    '3.新しいブックから「Sheet*」のシートを消す
    I = 1: WB2.Activate
    Do Until I > WB2.Worksheets.Count
      If Sheets(I).Name Like "Sheet*" Then
        Sheets(I).Delete
        I = I - 1
      End If
      I = I + 1
    Loop

    '■ファイル名をつけて保存
    MyFile = ThisWorkbook.Path & "\" & MyDate
    WB2.Close SaveChanges:=True, Filename := MyFile '(※6)
    OKLook
  End Sub


(解説)
 ※1
  =上の例だと入力させるのは1回きりだが、入力完了するまで
   回したい、もしくは終了を選択したい場合は以下の通り。
   フラグがTrueになるか処理を抜ける判断をしたら処理を抜けます。

  --------------------------------

   Sub test_012()
     Dim FLG   As Boolean
     Dim MyStr As String
     Dim MSG   As String

     FLG = False
     Do
      MyStr = InputBox("数字を入力してください", "入力")
      If IsNumeric(MyStr) Then FLG = True
      If Not FLG Then
        MSG = MsgBox("空白、もしくは数字以外が入力されました。" & _
               vbCrLf & vbCrLf &  "入力を繰り返しますか?", & _
               vbQuestion + vbYesNo, "確認")
       If MSG = vbNo Then Exit Do
      End If
     Loop Until FLG
     If Not FLG Then Exit Sub
     MsgBox MyStr & " : " & FLG
   End Sub

  --------------------------------

 ※2
  =「If Not IsNumeric(MyDate)」
   ・・・IsNumeric(対象) : 対象が数字か判断
   ・・・Not ~ : 結果がTrueかFalseになる式の時、「If ○ Then」だと
           「Trueの時」になるが、Notがつくと「Falseの時」になる

 ※3
  =「Replace(Left(WHX.Range("B1").Value, 7), "/", "")」
   ・・・Left(文字列, 文字の長さ) : 文字列の左から文字数分取得
   ・・・Replace(文字列, 検索文字列, 置換後文字列)
       : 文字列に含まれる検索文字列を置換後文字列に変換する
   今回の場合は、「2012/11」と取った値から「/」を「」に置換して
   「201211」の形にした

 ※4
  =「シート.Move After:=[ブック.]Sheets([ブック.]Worksheets.Count)」
   ・・・シート.Move  : シートを移動する
   ・・・After:=シート : 以降で指定したシートの後ろ
   ・・・Sheets(Worksheets.Count) : 最後のシート

 ※5
  =シートが1枚減ったので、その分のカウントを削っている

 ※6
  =「ブック.Close SaveChanges:=True, Filename := ファイル名」
   ・・・SaveChanges : 保存して閉じるか否か
   ・・・Filename  : 名前をつけて保存する場合のファイル名

   2行にするなら「WB2.SaveAs MyFile(保存)」→「WB2.Close(閉じる)」


--------------------------------

以上が「月が替わったら前月のシートを全て新しいブックに移す」でした。
もう少しスマートなやり方があるかもしれませんので、実際にお試しの方は
内容に合わせて改変してみてください。

また、今回はいちいち日付を選ぶやり方ですが、
その内「○月」と指定したらその月分を抜き出す方法を
出そうと思います(そちらもやり方はあるので)

では今回はこの辺りで。

拍手[0回]

Posted by 若槻風亜 - 2014.06.06,Fri
(対象)Excel VBA
(確認)Excel2003(多分2010でも使える)

今回はCSVの読み込み及び書き込みについてを書いていこうと思います。
データがCSVになっている、データをCSVに出力したいということは
意外に多いです。

それこそ色々やり方がありそうなものですが、
とりあえずここでは標準的なものを挙げてみます。


----------------------------------
(前提)
 1.DontLookやOKLookなどを使用→詳しくはこちら

(プログラム 読み込み)
  '==========================================================
  ' 読み込んだCSVをシートに展開
  '==========================================================
  Sub ReadCSV()
    Dim FileNo   As Integer
    Dim MyStr    As String
    Dim StrBox()  As String
    Dim WH1     As Worksheet
    Dim I As Long, J As Integer, K As Integer
    DontLook
    '■読込先を初期化
    Set WH1 = Worksheets("作業用")
    WH1.Cells.Delete
    '■読み込み→写し
    FileNo = FreeFile  ’(※1←↓)
    Open ThisWorkbook.Path & "\テスト用データ.csv" For Input As #FileNo
    MyStr = "": I = 1
    Do Until EOF(FileNo) '(※2)
      '△一行分読み込み
      Line Input #FileNo, MyStr  '(※3)
      '△区切り文字(この場合は「,」)を探す(※4)
      StrBox = Split(MyStr, ",")
      For J = 0 to Ubound(StrBox)
        WH1.Cells(I, J + 1).Value = StrBox(J)
      Next
      I = I + 1
    Loop
    '■閉じる
    Close #FileNo
    OKLook
  End Sub

(解説)
 ※1
  =指定したCSVを開く
  ★「変数 = FreeFile」
    = 変数に空いているファイル番号(FreeFile)を格納
  ★「Open ファイル名 For 処理モード As #ファイル番号」
    =指定したファイルを指定したファイル番号で、指定した
     処理モードで開く
     ※処理モード
      ・・・Input : 入力モード(読み込み)
      ・・・Output : 出力モード(書き込み)
      ・・・Append : 追加モード(書き込み)
      ・・・Random : ランダムアクセスモード(読み込み/書き込み)
      ・・・Binary : バイナリモード(読み込み/書き込み)

 ※2
  =「Do Until EOF(ファイル番号)」
    指定したファイルを読み終わるまで
 ※3
  =「Line Input #ファイル番号, 変数」
    ファイルの内容を1行読み込み、その内容を変数に格納する

 ※4
  =区切り文字で値を区切り、配列変数に格納
   →データをシート上に展開

----------------------------------
(プログラム 書き込み)
  '=========================================================
  ' CSVに出力する
  '=========================================================
  Sub OutPutCSV()
    Dim WH1     As Worksheet
    Dim I As Long, J As Long, K As Integer
    '■読込先を初期化
    Set WH1 = Worksheets("作業用")
    '■CSV作成
    WH1.Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\aaa", _
               FileFormat:=xlCSV
    ActiveWindow.Close False
    MsgBox "CSVファイルが作成されました" & vbCrLf, vbInformation, "終了報告"
  End Sub

(解説)
 ★CSVの作成
  1.CSVにしたいシートをコピー
  2.名前をつけて形式を選択して保存
    「ブック.SaveAs FileName:=パス\ファイル名, FileFormat:=xlCSV」
    ※FileFormatで指定出来るファイル : 参照URL(http://www.officepro.jp/excelvba/book_new/index9.html)

----------------------------------

以上がCSVの読み込みと書き込みについてです。
もっとスマートなやり方やそれぞれの細かい内容については
グーグル先生にお尋ねくださいませ。

では、今回はこの辺りで。


拍手[0回]

Posted by 若槻風亜 - 2014.05.29,Thu

今回はこのブログ内でExcelのVBAをご紹介する際
必ずと言っていいほどよく出るプロシージャを
まとめておきます。


=======================
1.シートのセット
=======================
'■変数の宣言
Public WH1 As WorkSheet
Public WH2 As WorkSheet
Public WH3 As WorkSheet

'■シートセットのプロシージャ
Sub SheetSet()
  Set WH1 = Worksheets("シート名1")
  Set WH2 = Worksheets("シート名2")
  Set WH3 = Worksheets("シート名3")
End Sub
―――――――――――――――――――――――
これを作っておくと、たとえば
Sub AAA ()
  SheetSet '←これで呼び出し
  WH1.Range("A1").Value = "hhh"
End Sub

のように使えます。
上でやっているのは、WH1(=シート名1)の
A1セルに「hhh」を格納する、です。


シートのセットを変数で行っておく利点は、

 1.シート名が変更になった時にそこだけ
   直せば済む
 2.シートのプロパティが絶対予測で出てくる

があります。
ブログ主はExcelでプログラミングする際は
絶対に使うプロシージャの1つです。





=======================
2.描画の停止と開始等々
=======================

'■描画の停止他
Sub DontLook()
  '画面の移動を見せない
  Application.ScreenUpdating = False
  '確認メッセージを出さない
  Application.DisplayAlerts = False
  'マクロの動作が起因するイベント発生を抑制
  Application.EnableEvents = False
End Sub

このマクロを入れておくだけで画像のちらつきがなくなります。
ちなみにこの反対はこちら
'■描画の開始他
Sub OKLook()
  '画面の移動を見せる
  Application.ScreenUpdating = True
  '確認メッセージを出す
  Application.DisplayAlerts = True
  'マクロの動作が起因するイベント発生を抑制しない
  Application.EnableEvents = True
End Sub


ちなみに使い方は

Sub BBB ()
  DontLook
  (作業)
  OKLook
End Sub

という感じです。
値を次々に入れていく、などの作業の時は
あった方が目に痛くない優しいシステムに
なるのではないかと思います。

1番と併せて、ブログ主が絶対に使うプロシージャです。




ということで、このブログ内でよく使われる
プロシージャでした。



拍手[0回]

プロフィール
HN:
若槻風亜
性別:
女性
職業:
会社員
趣味:
創作、プログラミング
自己紹介:
仕事や個人で学んだことをまとめておきたかったがために備忘録ブログを立ち上げました。
あくまで自分が学んだこと・自分が出来たことなので、ご覧くださる場合は参照レベルでお願いします。
ブログ内検索
カレンダー
04 2017/05 06
S M T W T F S
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 31
P R
最新トラックバック
コガネモチ
フリーエリア



Template by mavericyard*
Powered by "Samurai Factory"
忍者ブログ [PR]