6月の蜜蜂 https://ameblo.jp/lioney09/ 自由気まま！普通のことも書けば腐男子としての日常も書く…予定。 ja SEメモその１ Sub SpinLock()
'=============================================
'概要：スピンボタンの参照をOffset(0, 1)に強制します①
'引数：なし
'戻り値：なし
'=============================================
  With ActiveSheet.Shapes(Application.Caller)
    .TopLeftCell.Offset(0, 1) = .OLEFormat.Object.Value
  End With
End Sub
Sub RecordAdd()
'=============================================
'概要：タスク及びレコードを追加します
'引数：なし
'戻り値: なし
'=============================================
Range("A1").Value = "ロック"
Dim i As Integer 'レコードの最終行を特定する変数
Dim str As String 'タスク名
'タスク名の入力
str = InputBox("TASK名を入力してください。", "TASK名")
If str = "" Or str = "[100%samp]" Or str = "[0%samp]" Then
    Exit Sub
End If

'変数の初期化
i = 4
'最終行取得
Do
    i = i + 1
Loop While Cells(i, 3).Value <> ""
'レコード追加
Cells(i - 1, 3).Select
Selection.ListObject.ListRows.Add AlwaysInsert:=True
'スピンボタンのコピー
Cells(i - 1, 2).Copy Cells(i, 2)
'その他レコードのカラム毎初期値設定
Cells(i, 3).Value = 0
Cells(i, 2).Value = str

'レコードの並び替え
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("テーブル1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("テーブル1").Sort.SortFields.Add _
        Key:=Range("テーブル1[進捗]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("テーブル1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Range("A1").Value = ""
End Sub
Sub MakeTaskFile()
'=============================================
'概要：選択したタスクの作業フォルダを作成します。
'引数：なし
'戻り値: なし
'=============================================
Dim rng As Range '選択範囲を取得する変数
Dim taskName As String '選択したタスクの名前
Dim mkFileName As String '作るファイルの名前
Dim mkNum As Integer '作るファイルの連番
Dim runFile As String '走査するファイル名を格納する変数
Dim runNum As Integer '走査する連番を格納する変数
Dim runTask As String '走査するタスク名を格納する変数
Dim numExist As Boolean '連番がすでに存在するかどうかを表す

Range("A1").Value = "ロック"
'選択範囲からタスク名を取得する
Set rng = Range(Selection.Address)
taskName = Cells(rng.Row, 2).Value
'エラーチェック：選択したタスクが適しているか判定
If taskName = "" Or taskName = "[0%samp]" Or taskName = "[100%samp]" Or taskName = "TASK名" Then
    MsgBox "ファイルを作成したいTASKを選択してください。", vbCritical
    Range("A1").Value = ""
    Exit Sub
End If

'フォルダを走査する前の初期値設定
mkFileName = "TASK_01_" & taskName & "_" & Format(Date, "mmdd")
mkNum = 1
numExist = False
'フォルダ走査
1:
runFile = Dir(ThisWorkbook.Path & "\TASK*", vbDirectory)
Do While runFile <> ""
    runNum = Val(Left(Mid(runFile, 6), 2))
    runTask = Left(Mid(runFile, 9), InStr(Mid(runFile, 9), "_") - 1)
    '既にタスクファイルが作られてないかチェック
    If runTask = taskName Then
        MsgBox "そのタスク名のファイルは既に存在しています。", vbCritical
        Range("A1").Value = ""
        Exit Sub
    End If
    '連番が既に存在していないかチェック
    If runNum = mkNum Then
        numExist = True
    End If

    runFile = Dir()
Loop
'連番が既に存在していれば連番の数を一つ上げて再走査
If numExist = True Then
    mkNum = mkNum + 1
    mkFileName = "TASK_" & Format(mkNum, "00") & "_" & taskName & "_" & Format(Date, "mmdd")
    numExist = False
    GoTo 1
End If
'条件を満たしていればフォルダ作成
MkDir (ThisWorkbook.Path & "\" & mkFileName)
'その配下に作業メモを置く
Open ThisWorkbook.Path & "\" & mkFileName & "\作業メモ" For Output As #1
    Print #1, taskName & "の作業メモ"
Close #1

MsgBox taskName & "のタスクフォルダを作成しました。"
Range("A1").Value = ""
End Sub

以下シートに

 

Private Sub Worksheet_Change(ByVal Target As Range)
'=============================================
'概要：スピンボタンの参照をOffset(0, 1)に強制します②
'また進捗が100を記録した場合降順に並べます。
'引数：target as range
'戻り値: なし
'=============================================
Dim shp As Object
For Each shp In ActiveSheet.Shapes
    If shp.Name Like "*Spinner*" And Target.Address = Cells(shp.TopLeftCell.Row, shp.TopLeftCell.Column + 1).Address Then
        shp.OLEFormat.Object.Value = Target.Value
    End If
Next
'進捗が100を記録した場合降順に並べます。
If Range("A1").Value <> "ロック" Then
If Target.Column = 3 And Target.Value = 100 Then
    taskName = Cells(Target.Row, Target.Column - 1).Value
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("テーブル1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("テーブル1").Sort.SortFields.Add _
        Key:=Range("テーブル1[進捗]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("テーブル1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End If
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'=============================================
'概要：レコードを削除します。
'引数：target as range,Cancel As Boolean
'戻り値: なし
'=============================================
Dim ans As String
If Target.Column > 1 And Target.Column < 9 And Target.Row > 4 And Cells(Target.Row, 3).Value <> "" And Cells(Target.Row, 2).Value <> "[0%samp]" And Cells(Target.Row, 2).Value <> "[100%samp]" Then
    ans = MsgBox("TASKを削除しますか？", vbYesNo, "削除確認")
    If ans = vbYes Then
    Range("A1").Value = "ロック"
    Selection.ListObject.ListRows(Range(Selection.Address).Row - 4).Delete
    Range("A1").Value = ""
    End If
End If
Cancel = True
End Sub

 

]]> https://ameblo.jp/lioney09/entry-12451538090.html Tue, 02 Apr 2019 23:42:19 +0900 今日のおさらい？ヾ(`∀´*)ﾉ 汗３日目!!(｀・ω・´)キリメモ



今日はいい日曜日でした～ヾ(`∀´*)ﾉ

午前中は家でグダグダして

で、午後からちょっと出かけた!晴れ



散歩がてらにね

昨日言ってたGファンタジー買うためにもパンダ



そしたらスーパーで友達に偶然会ったりして！ビル

互いの買い物に付き合ったりして…



「今日の夕食何なん？」

「オレ、○○～」

「あ、じゃぁ、××いるんとちゃうん？

オレ取ってきたろかぁ？」

「あ、確かに…。あ、待って。オレも行く～」

＊会話一部抜粋

…みーたいなほのぼの感(^０^)

おもろかった～にゃー

楽しかった～wキラキラ



家帰って、またPCつけながらゴ～ロゴロ…ゴロゴロ゛

で、ブログなう。。



さて、今日のおさらいはこんくらいにして…。。

本題!!



テーマ「君と僕。」を追加しました!!アップ


ちゃんと画像のせれてるかな…



そもそもなんでGファンタジーを毎月購入してるかって、

この漫画「君と僕。」のために買ってるようなもの本

最近アニメ化もされたのがファンとして嬉しいクローバー



しかも付録が毎回すごいの!!

今回はリバーシブル下敷きなのだ! (・∀・ )



漫画の方、

今回もおもろかったw

笑ったわぁw



内容についてはネタバレになるから

あんまし言わない…



ただ一つだけ言わせて貰うなら…



塚原家玄関でのちーさんの格好に

ちょっとキュンときた///キラキラ


今回の付録




ゴシックな感じの５人

カッケぇなぁ…!!　オイっ!(〃∇〃)

浅羽ツインズとか要っちとか…

春ちゃんは女役じゃないのねw今回w


特ににちーさん!!

頭濡らしちゃって!!キラキラ


かわえぇぇわぁ…グッド！


使うの勿体無いからもう一冊買ってこようか…オレ(^ ^;)



あ、一応言うけど、

君と僕。は腐的な感じでは決して見てません!!

なんか、この作品はそういうの抜きにして

楽しみたいっていうか…



んにしても、

ホント好きすぐる…(´－｀ )


これからも応援してるぜぃ!!

君と僕。!!


今日はこのへんで!!


汗それでは!!クローバー


 ]]> https://ameblo.jp/lioney09/entry-11143292181.html Sun, 22 Jan 2012 21:52:45 +0900 TOEIC受けてきたぜぃ(・∀・ ) 汗ブログ2日目～メモ


TOEIC受けてきましたよ!!っと(・∀・ )

これ受けてないと単位貰えないんだって!!


え～、そんなケチケチしてないで単位の１，２個くらい、くださいよ～（≧ε≦)

・・・な～んて、言えたらいいのにな～汗


勉強やりたくないよ～（TДT)

もうすぐ期末考査だし。

課題山積みだし本。。


まぁ、全国の受験生はそれどころじゃないんでしょうが・・・

頑張れ～、受験生!!o(・ﾛ・〃)フラッグ

オレも頑張るから～っ。。


う～ん、

今日はもう特にないんですけど・・・あせる




あ、じゃぁ明日、先日発売されたGファンタジー買ってくるキラキラ

一応、毎月買ってるんでね。ブログのネタにもできるし？

うん（－＿－；）


それからね～、

たま～にだけど小説載せてみたいなぁ・・・

なんて思ってたり。

これは腐男子の活動として。。


ってゆう活動告知？みたいな


…おぉ…、なんか…

ブログらしい動き出しになってる!？Σ(－Д－*)

自分でびっくり。。


…続くかな～、このブログ(*￣－￣) （←遠い目）


頑張っていきますんでよろしくお願いしまぁ～すアップ


最後に、

オレの大好きな二人ぐみの…

田島と三橋でハイタッチ!!


みっはし～!!☆ (*｀▽´)人(゜◇゜*) た、たじまくん!!


タジミハ(^q^)


ただの自己満足です

わかんない人もいるのに…あせる

すんません…

何してんだ、オレは…orz

一応おお振りのCP


今日はこんくらいで


汗ではでは～クローバー

]]> https://ameblo.jp/lioney09/entry-11142172800.html Sat, 21 Jan 2012 19:06:32 +0900 ぶろぐコトハジメ 3日坊主なオレがどれだけ持たせられるか…あせる

何かあり次第報告いれま～すドキドキ (´▽ ｀ )

とりあえず明日はTOEICのテストなんで～ぶーぶー

面白い記事は明日以降書こうかと・・・


ハっ、もう今日やん!!(ﾟДﾟ)


じゃ、おやすみなさいぐぅぐぅ

]]> https://ameblo.jp/lioney09/entry-11141468297.html Sat, 21 Jan 2012 00:25:27 +0900