【CDラベル】MAN WITH A MISSION -Chasing the Horizon-

June 17 [Sun], 2018, 15:22
5thアルバム発売おめでとうございまーす!!!
今回も北海道にはツアーではきてくれないんですけどね。

限定・タイトル版


限定・特典版


限定・無地版


通常・タイトル版


通常・特典版


通常・無地版
私は限定・タイトル版と通常の特典版を使ってます。

とりあえず旅行でも行ってきます…。

【フリーライン素材】MWAMロゴたちA

April 15 [Sun], 2018, 15:31
さっきアップしておいて、なんだか同じ背景色だな…と思いつつも前回使っていたフリーラインの狼デッキを作りました。
使い方についてはこちらをご参照ください。おだやか面でございます。(再現)
これまたおだやかの画像が荒く、なかなかうまく作れなかったのですが、透明のデッキテープを上から貼るので粗さはさほど気になりません(笑)

フリーラインのめんこいデッキがいっぱいできますように。
ちなみに私の今のデッキはチームロゴと5yearsのロゴの桜verです。
チームは微塵も有名ではございませんが、みんなで楽しくやっております。





<検索用>
#MWAM #フリーライン #デッキテープ #MAN WITH A MISSION #狼 #フリーラインスケート #ロゴ #おだやか

【フリーライン素材】MWAMロゴたち

April 15 [Sun], 2018, 14:27
お久しぶりです。
そろそろ狼たちの新しいCDが発売ですね。
 
趣味でフリーラインスケートをやっておりまして、デッキテープをこの度新調いたしました。
狼のロゴを使いたくてテキトー(あえてこの文字)にしたため、あまりきっちりきれいに作ってはおりませんが、趣味でやっている狼好きファンの方に使っていただけたらと思います。あくまで私の使い方ですが参考に…
【用意するもの】
・A4サイズのインクジェット対応のシールシート(できれば光沢・防塵・防水のもの)
・JMKで売っているクリア1枚タイプのデッキテープ

【テスト印刷】
@画像をダウンロードしA4サイズの普通紙へテスト印刷します。
A線にそって切り取り、デッキテープと合わせてみてサイズを確認します

【本番印刷】
@シールシートへ印刷
Aデッキテープのシートをはがし、シール面を出す
Bデッキテープをシールシートに重ねるように貼る
Cシールシートのシートを外してフリスケに貼る

結構一発勝負が多いので頑張ってください。
なお、この画像がズレてる!!汚い!!などの苦情は受け付けておりませんので(リクエストはお伺いいたします/やるかどうかは別として←)ご了承くださいませ。

前に作ったおだやかデッキは気に入っていたのに、データをどっかにやってしまった。。。
本当はネジ穴をあけたいんだけど…どこかわからん。。。





<検索用>
#MWAM #フリーライン #デッキテープ #MAN WITH A MISSION #狼 #フリーラインスケート #ロゴ

【CDラベル】ヤバイTシャツ屋さん-Galaxy of the Tank-top-

February 17 [Sat], 2018, 0:07
一緒にアルバムを借りたので、ヤバT続きです◎
結構人気だと思ったらラベルが見つけられない。。。

こっちの方がオリジナリティあふれてたわ…。(地球儀のところとか)
ヤバTはライブに誘われたけども、インフル真っただ中で行けず。。。悲しい…。。。

よろしかったらお使いください。
気が向いたらコメント頂けると嬉しいです。

【CDラベル】ヤバイTシャツ屋さん-We love Tank-top-

February 17 [Sat], 2018, 0:02
最近、遅ればせながらハマっております。
ヤバT。狼のチケットは相変わらず落選続きで不貞腐れております。。。
ワンマンきておくれ…北の大地に…降臨しろ。そしてチケ当たってくださいおねがいします。。。
 
ちょっといじるの大変だったのとオリジナリティあふれてますが。
よかったらどうぞ◎

【DVDラベル】MAN WITH A MISSION -狼大全集X-

June 18 [Sun], 2017, 0:43
大人気でチケットが取れず…行けなかったライブのDVD狼大全集Xが発売されましたね◎
毎回微妙にDVDの真ん中の円がタナパイに被っているため、今回もこんな微妙な感じに…orz



仕事で色々ありますが、狼見てガウばります。。。
 
よければ使ってやってください◎

韓国に行ってきた&またこれから行くのでメモがてら。

June 10 [Sat], 2017, 11:10
画像を残しておこううっとー。




【CDラベル】劇団四季 -ライオン・キング-

May 03 [Wed], 2017, 0:50
ライオンキング、すでに5回程見ています。
どの曲も素晴らしい!!

劇団四季最高です◎

シャドウランドがお気に入りです。
車の中でシャウトしてます。

仕事用(処理)

October 10 [Mon], 2016, 22:06
A1は空白
A2はタイトル(仮に:ファイル)
A3以下ファイルパス+ファイル名まで

===================================
Option Explicit

Sub FileKiller()

Dim i As Variant
On Error Resume Next

i = 3
Do Until Cells(i, 1) = ""
Range("A" & i).Select
Kill ActiveCell

i = i + 1
Loop


MsgBox "終了"

End Sub
===================================


===================================
Option Explicit

Sub test() ' テストプログラム

DeleteFolders "C:\Users\琳子_naomi\Desktop\aaa"

End Sub

' フォルダー削除関数
' 指定フォルダー内の空フォルダーを削除する
' 指定フォルダー内にファイルフォルダーが一個も無くなったら True を返す
Private Function DeleteFolders(Path As String) As Boolean
Dim FilesCnt As Long ' このフォルダー内のファイルの数
Dim Folders() As String ' このフォルダー内のフォルダー一覧
Dim FoldersCnt As Long ' このフォルダー内のフォルダーの数
Dim FileName As String
Dim NewPath As String
Dim i As Long


FilesCnt = 0 ' このフォルダー内のファイルの数を0に

FoldersCnt = 0 ' このフォルダー内のフォルダーの数を0に
ReDim Folders(0 To 0) ' このフォルダー内のフォルダー一覧をクリア

FileName = Dir(Path & "\*.*", vbDirectory) ' ファイル/フォルダーの初期検索

While FileName <> "" ' ファイル/フォルダーが無くなるまで繰り返す
If FileName <> "." And FileName <> ".." Then
NewPath = Path & "\" & FileName
If (GetAttr(NewPath) And vbDirectory) = vbDirectory Then
' 検索したのがフォルダーならフォルダー一覧の登録とフォルダー数のカウントアップ
FoldersCnt = FoldersCnt + 1
ReDim Preserve Folders(0 To FoldersCnt)
Folders(FoldersCnt) = NewPath
Else
' 検索したのがファイルならファイル数のカウントアップ
FilesCnt = FilesCnt + 1
End If
End If
FileName = Dir ' 次のファイル/フォルダーの検索
Wend

' 下位の各フォルダーでの削除処理を行う
For i = 1 To UBound(Folders)
' 自身を呼び出して下位フォルダーの削除を行う
If DeleteFolders(Folders(i)) = True Then
' Trueでリターンしたらフォルダーの削除とフォルダー個数 -1 する
RmDir Folders(i)
FoldersCnt = FoldersCnt - 1
End If
Next i

' フォルダーもファイルも無くなったら True
' 一方でも残っていたら False を返す
If FoldersCnt <= 0 And FilesCnt <= 0 Then
DeleteFolders = True
Else
DeleteFolders = False
End If

End Function


===================================
Option Explicit

Sub filehenkan()


Dim i As Variant
On Error Resume Next

i = 3
Do Until Cells(i, 1) = ""
Range("A" & i).Select
Workbooks.Open ActiveCell


If Right(ActiveWorkbook.Name, 4) = ".xls" Then
Dim book1 As Workbook

ActiveWorkbook.SaveAs FileName:=ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ".xlsx", _
FileFormat:=xlWorkbookDefault

Workbooks(ActiveWorkbook.Name).Close


' ElseIf Right(ActiveWorkbook.Name, 4) = ".doc" Then
' Dim book2 As Workbook
'
' Set book2 = Workbooks(ActiveWorkbook.Name & ".docx")
' book1.SaveAs FileName:=ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ".docx", _
' FileFormat:=wdFormatDocument
'
'
'
' ElseIf Right(ActiveWorkbook.Name, 4) = ".ppt" Then
' Dim book3 As Workbook
'
' Set book3 = Workbooks(ActiveWorkbook.Name & ".pptx")
' book1.SaveAs FileName:=ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ".pptx", _
' FileFormat:=ppSaveAsDefault


End If

i = i + 1
Loop


MsgBox "変換終了"



End Sub


ファイル解析(更新日時追加ver)

August 13 [Sat], 2016, 21:57
http://www.vector.co.jp/soft/winnt/util/se499921.html



Option Explicit


'FileSystemObjectを使用しているため、
'VBA Project で Microsoft Scripting Runtime の参照設定が必要

'Folder オブジェクトの Size プロパティでもフォルダのサイズは取得できるが
'FileSystemObject内部で最下位までのスキャンが実行され反応が停止するため
'FolderオブジェクトのSize プロパティは使用していない。


Dim csListBaseCell As Range '結果リストの左角起点セル(見出し行は含まない)
Dim Y As Long '結果リストの現在表示行位置(起点0)

'---- オプションパラメータ
Dim mMaxDirLevel As Long '階層表示の階層限度
Dim mIsDataList As Boolean '階層情報セルに親階層を併記するかどうか
Dim mIsFolderOnly As Boolean 'フォルダのみ列挙かどうか
Dim mIsFullScan As Boolean '最下層まで集計するかどうか

Dim mColorRoot As Long '前景色 開始フォルダ
Dim mColorFolder As Long '前景色 Type=フォルダ
Dim mColorFile As Long '前景色 Type=ファイル

'---- 集計
Dim mCountOfFolder As Long 'ステータスバーに表示する処理経過件数用(フォルダ個数)
Dim mCountOfFile As Long 'ステータスバーに表示する処理経過件数用(ファイル個数)
Dim mLastLevel As Long '探索した階層の最大


'---- 結果表の列位置
Private Enum ColumnPosEnum
ObjectName = 0 '名称(フォルダまたはファイルの)
FullPath = 1 'フルパス
ObjectTypeName = 2 '形式(フォルダ/ファイル)
TotalSize = 3 'サイズ (フォルダは内容のサイズ)

'追加1
LastModified = 4 ' **追加**(以降の数字を+1すること)
'

CountOfFolder = 5 '下位フォルダ(サブフォルダ含む)の個数。
CountOfFile = 6 '下位ファイル(サブフォルダ内を含む)の個数。
HierarchyLevel = 7 '開始フォルダを0とした階層レベル
HierarchyInfo = 8 '階層形式の表示
End Enum

'---- オブジェクトの形式表示名
Private Const csObjectTypeName_Folder As String = "フォルダ"
Private Const csObjectTypeName_File As String = "ファイル"


Private Sub ctrCmdRun_Click()
'======================================================================
' 開始ボタン OnClick
'======================================================================

'---- 開始フォルダの入力有無
If ActiveSheet.Range("B3") = "" Then
MsgBox "開始フォルダを入力してください。"
Exit Sub
End If

'---- オプション値(詳細な値検査は省略)
On Error GoTo lbl_err_params
mMaxDirLevel = CInt(ActiveSheet.Range("D3").Value)
mIsDataList = (ActiveSheet.Range("D6").Value = 1)
mIsFolderOnly = (ActiveSheet.Range("D9").Value = 0)
mIsFullScan = (ActiveSheet.Range("D12").Value = 1)
mColorRoot = ActiveSheet.Range("D15").Font.Color
mColorFolder = ActiveSheet.Range("D16").Font.Color
mColorFile = ActiveSheet.Range("D17").Font.Color
On Error GoTo 0

Dim fso As FileSystemObject

'---- 開始フォルダの有無
Set fso = New FileSystemObject
If Not fso.FolderExists(ActiveSheet.Range("B3").Text) Then
Set fso = Nothing
MsgBox "開始フォルダがありません。"
Exit Sub
End If

'---- 開始確認
If MsgBox("開始しますか?", vbYesNo + vbDefaultButton2 + vbQuestion) <> vbYes Then
Set fso = Nothing
Exit Sub
End If

'---- 処理実行
Dim wRetOK As Boolean
wRetOK = DoWork(fso.GetFolder(ActiveSheet.Range("B3").Text))
Set fso = Nothing

'---- 結果メッセージ
If Not wRetOK Then
MsgBox "エラーにより中止しました。", vbCritical
Else
MsgBox "終了", vbInformation
End If


Exit Sub

lbl_err_params:
MsgBox "最大階層・階層形式・内容 の指定が正しくありません。" & vbCrLf & Err.Description, vbCritical
Exit Sub
End Sub

Private Function DoWork(ByRef pStartFolder As Scripting.Folder) As Boolean

On Error GoTo lbl_err
DoWork = False

'結果表示用のワークシートを追加
Dim ws As Excel.Worksheet
Set ws = ThisWorkbook.Worksheets.Add

'表内容の左上角セル
Set csListBaseCell = ws.Range("A2")
Set ws = Nothing

'列見出し
csListBaseCell.Offset(-1, ColumnPosEnum.ObjectName).Value = "名称"
csListBaseCell.Offset(-1, ColumnPosEnum.FullPath).Value = "フルパス"
csListBaseCell.Offset(-1, ColumnPosEnum.ObjectTypeName).Value = "形式"
csListBaseCell.Offset(-1, ColumnPosEnum.TotalSize).Value = "サイズ"

'追加2
csListBaseCell.Offset(-1, ColumnPosEnum.LastModified).Value = "最終更新日時" ' **追加**
'

csListBaseCell.Offset(-1, ColumnPosEnum.CountOfFolder).Value = "フォルダ数"
csListBaseCell.Offset(-1, ColumnPosEnum.CountOfFile).Value = "ファイル数"
csListBaseCell.Offset(-1, ColumnPosEnum.HierarchyLevel).Value = "階層番号"

'フォルダ・ファイル件数カウンタ初期化(ステータスバーに表示する)
mCountOfFolder = 0
mCountOfFile = 0

'実際に探索した階層レベル
mLastLevel = 0

'開始フォルダの情報とその下位オブジェクトの列挙処理
Dim wCountOfFolder As Long
Dim wCountOfFile As Long
Dim wTotalSize As Variant
wCountOfFolder = 0
wCountOfFile = 0
wTotalSize = 0
Y = -1
Call PrintObjectInfo(csObjectTypeName_Folder, pStartFolder, 0, wCountOfFolder, wCountOfFile, wTotalSize)

'列見出し(階層1、階層2、階層…、の見出し)
Dim j As Long
For j = 0 To mLastLevel
If mMaxDirLevel <> -1 And j > mMaxDirLevel Then
Exit For
End If
csListBaseCell.Offset(-1, ColumnPosEnum.HierarchyInfo + j).Value = "階層" & CStr(j)
Next

'終了
DoWork = True
Exit Function

lbl_err:
Set ws = Nothing
MsgBox Err.Description
DoWork = False
Exit Function
End Function

Private Sub PrintObjectInfo( _
ByVal pObjectTypeName As String, _
ByRef pObject As Object, _
ByVal pLevel As Long, _
ByRef outCountOfFolder As Long, _
ByRef outCountOfFile As Long, _
ByRef outTotalSize As Variant _
)
'======================================================================
' オブジェクトの情報表示とその下位オブジェクト列挙
' pObject : 処理対象オブジェクト(ファイルまたはフォルダ)
' pObjectTypeName : ファイル/フォルダのどちらであるか
' pLevel : 開始フォルダを0とした階層レベル
' outCountOfFolder : 結果通知 下位フォルダ個数(自身は含まない)
' outCountOfFile : 結果通知 下位ファイル個数
' outTotalSize : 結果通知 下位ファイルサイズ合計
'======================================================================


'オブジェクトの情報表示
Call PrintObjectInfoCurrent(pObjectTypeName, pObject, pLevel)


'ステータスバーに経過件数表示
Select Case pObjectTypeName
Case csObjectTypeName_Folder
mCountOfFolder = mCountOfFolder + 1
Case csObjectTypeName_File
mCountOfFile = mCountOfFile + 1
End Select
Application.StatusBar = _
"フォルダ " & Format(mCountOfFolder, "#,##0") & "個 " & _
"ファイル " & Format(mCountOfFile, "#,##0") & "個 "

DoEvents


'下位オブジェクトの列挙

'ファイルのときは下位がないので終了
If pObjectTypeName = csObjectTypeName_File Then
outCountOfFolder = 0
outCountOfFile = 0
outTotalSize = pObject.Size
Exit Sub
End If

'フルスキャン不要であれば指定最大階層に到達しているとき下位処理は不要
If (Not mIsFullScan) And (mMaxDirLevel <> -1) And (pLevel >= mMaxDirLevel) Then
Exit Sub
End If

'以降はフォルダの場合
Dim wDir As Scripting.Folder
Set wDir = pObject

'現在行位置を保存
'(*) 後で下位の個数・サイズ集計値をセルにセットするため
'(*) y は下位オブジェクトの再帰処理過程で変化する
Dim thisY As Long
thisY = Y

'戻値初期化
outCountOfFolder = wDir.SubFolders.Count
outCountOfFile = wDir.Files.Count
outTotalSize = 0

'下位オブジェクト(フォルダとファイル)について再帰処理
'フォルダとファイルとで行う処理は同じなので、
'wObjectTypeIdを、0:フォルダ, 1:ファイル と変化させて For-Next Loop
Dim wObjectTypeId As Long
Dim wObjectTypeName As String
Dim wObjectCollection As Object
Dim wObjectItem As Object
'下位オブジェクトごとの集計用
Dim wCountOfFolder As Long
Dim wCountOfFile As Long
Dim wTotalSize As Variant

'(*)フルスキャンが不要でファイル情報を表示しないときは下位ファイルの処理不要
Dim wObjectTypeIdEnd As Long
If (Not mIsFullScan) And mIsFolderOnly Then
wObjectTypeIdEnd = 0
Else
wObjectTypeIdEnd = 1
End If

For wObjectTypeId = 0 To wObjectTypeIdEnd
Select Case wObjectTypeId
Case 0 'フォルダ
wObjectTypeName = csObjectTypeName_Folder
Set wObjectCollection = wDir.SubFolders
Case 1 'ファイル
wObjectTypeName = csObjectTypeName_File
Set wObjectCollection = wDir.Files
End Select

'直下フォルダ/ファイル
For Each wObjectItem In wObjectCollection
DoEvents

'実階層レベル
If pLevel + 1 > mLastLevel Then
mLastLevel = pLevel + 1
End If


'下位の集計要変数を初期化
wCountOfFolder = 0
wCountOfFile = 0
wTotalSize = 0

'オブジェクト情報とその下位列挙(再帰処理)
Call PrintObjectInfo(wObjectTypeName, wObjectItem, pLevel + 1, wCountOfFolder, wCountOfFile, wTotalSize)

'(フルスキャンの場合)
'集計結果を戻し値に累計
If mIsFullScan Then
outCountOfFolder = outCountOfFolder + wCountOfFolder
outCountOfFile = outCountOfFile + wCountOfFile
outTotalSize = outTotalSize + wTotalSize
End If
Next
Next

'(フルスキャンの場合)
'下位の集計結果を自身の情報行(thisY)のセルに記入
If mIsFullScan Then
If (mMaxDirLevel = -1) Or (pLevel <= mMaxDirLevel) Then
csListBaseCell.Offset(thisY, ColumnPosEnum.TotalSize).Value = outTotalSize
csListBaseCell.Offset(thisY, ColumnPosEnum.CountOfFolder).Value = outCountOfFolder
csListBaseCell.Offset(thisY, ColumnPosEnum.CountOfFile).Value = outCountOfFile
End If
End If

Exit Sub
End Sub

Private Sub PrintObjectInfoCurrent( _
ByVal pObjectTypeName As String, _
ByRef pObject As Object, _
ByVal pLevel As Long _
)
'======================================================================
' オブジェクトの情報表示
'======================================================================

'フォルダのみのときはファイル情報を表示しない
If mIsFolderOnly And pObjectTypeName = csObjectTypeName_File Then
Exit Sub
End If

'最大階層を超えるときは表示しない
If mMaxDirLevel <> -1 And pLevel > mMaxDirLevel Then
Exit Sub
End If

'表示セル行を次行に
Y = Y + 1

Dim wDir As Scripting.Folder
Dim wFile As Scripting.File

'オブジェクトの情報表示
'(*) フォルダのみ列挙のときはファイル情報行は表示せず集計処理のみ

'名称・形式・フルパス
'(*) pObjectの型は Folder/File プロパティ "Name", "Path" はどちらにもあるので型キャスト省略
'(*) ファイル名やフォルダ名をセルに入れたとき日付や数値と解釈されないよう
' 名称セルの表示形式(NumberFormatLocal)は文字列(@)にしている。

csListBaseCell.Offset(Y, ColumnPosEnum.ObjectName).NumberFormatLocal = "@"
csListBaseCell.Offset(Y, ColumnPosEnum.ObjectName).Value = pObject.Name
If pLevel = 0 Then
'(*) 開始フォルダだけはフルパスを名称に表示
csListBaseCell.Offset(Y, ColumnPosEnum.ObjectName).Value = pObject.Path
End If
csListBaseCell.Offset(Y, ColumnPosEnum.FullPath).Value = pObject.Path
csListBaseCell.Offset(Y, ColumnPosEnum.ObjectTypeName).Value = pObjectTypeName

'サイズ・個数
csListBaseCell.Offset(Y, ColumnPosEnum.TotalSize).Style = "Comma [0]"
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFolder).Style = "Comma [0]"
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFile).Style = "Comma [0]"
'(*) ファイルのとき、個数欄は空のセルにする
'(*) フォルダのとき、全個数集計時 … 後で集計値を上書きするので仮に0をセルに記入
'(*) フォルダのとき、直下個数のみ表示 … 直下個数を表示、サイズは省略
Select Case pObjectTypeName
Case csObjectTypeName_Folder
Set wDir = pObject
If mIsFullScan Then
csListBaseCell.Offset(Y, ColumnPosEnum.TotalSize).Value = 0
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFolder).Value = 0
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFile).Value = 0
'追加3
csListBaseCell.Offset(Y, ColumnPosEnum.LastModified).Value = 0 ' **追加**
'
Else
csListBaseCell.Offset(Y, ColumnPosEnum.TotalSize).Value = ""
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFolder).Value = wDir.SubFolders.Count
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFile).Value = wDir.Files.Count
'追加4
csListBaseCell.Offset(Y, ColumnPosEnum.LastModified).Value = wDir.DateLastModified ' **追加**
'
End If

Case csObjectTypeName_File
Set wFile = pObject
csListBaseCell.Offset(Y, ColumnPosEnum.TotalSize).Value = wFile.Size
'追加5
csListBaseCell.Offset(Y, ColumnPosEnum.LastModified).Value = wFile.DateLastModified ' **追加**
'
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFolder).Value = ""
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFile).Value = ""

End Select

'階層情報
'(*) 階層に応じて表示する列を変えて階層を表現
csListBaseCell.Offset(Y, ColumnPosEnum.HierarchyLevel).Value = pLevel
csListBaseCell.Offset(Y, ColumnPosEnum.HierarchyInfo + pLevel).NumberFormatLocal = "@"
If pLevel <> 0 Then
csListBaseCell.Offset(Y, ColumnPosEnum.HierarchyInfo + pLevel).Value = csListBaseCell.Offset(Y, ColumnPosEnum.ObjectName).Value
Else
'(*)開始フォルダだけはフルパスを表示
csListBaseCell.Offset(Y, ColumnPosEnum.HierarchyInfo + pLevel).Value = csListBaseCell.Offset(Y, ColumnPosEnum.FullPath).Value
End If

'データ形式の場合は、親フォルダ階層を同じ行に表示(一つ前の親階層情報をコピー)
If mIsDataList And pLevel <> 0 Then
With csListBaseCell
Call .Range(.Cells(Y - 1, ColumnPosEnum.HierarchyInfo + 1), .Cells(Y - 1, ColumnPosEnum.HierarchyInfo + pLevel)) _
.Copy(.Offset(Y, ColumnPosEnum.HierarchyInfo))
End With
End If


'着色
Dim wColor As Long
If pLevel = 0 Then
wColor = mColorRoot
Else
Select Case pObjectTypeName
Case csObjectTypeName_Folder
wColor = mColorFolder
Case csObjectTypeName_File
wColor = mColorFile
Case Else
wColor = 0
End Select
End If
csListBaseCell.Offset(Y, ColumnPosEnum.ObjectName).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.FullPath).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.ObjectTypeName).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFolder).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.CountOfFile).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.TotalSize).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.HierarchyLevel).Font.Color = wColor
csListBaseCell.Offset(Y, ColumnPosEnum.HierarchyInfo + pLevel).Font.Color = wColor

Exit Sub
End Sub


2018年06月
« 前の月  |  次の月 »
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
ラベル素材一覧
アイコン画像【CDラベル】
アイコン画像アーティスト別
アイコン画像■あ行
» エイミー・ワインハウス -Back to Black-
アイコン画像【DVDラベル】
» 研修用
» ひとり交換日記
アイコン画像【フリーライン素材】
» MWAMロゴたち
» MWAMロゴたちA
最新コメント
アイコン画像琳子
» 【CDラベル】MAN WITH A MISSION -MUSH UP THE WORLD- (2018年06月12日)
アイコン画像karin
» 【CDラベル】MAN WITH A MISSION -MUSH UP THE WORLD- (2018年06月12日)
アイコン画像琳子
» 【CDラベル】オールスター90'sベスト (2018年02月04日)
アイコン画像きらら
» 【CDラベル】オールスター90'sベスト (2018年02月04日)
アイコン画像琳子
» 【DVDラベル】MAN WITH A MISSION -狼大全集W- (2017年02月21日)
アイコン画像kaja
» 【DVDラベル】MAN WITH A MISSION -狼大全集W- (2017年02月21日)
アイコン画像琳子
» 【DVDラベル】MAN WITH A MISSION -狼大全集V-  (2016年07月01日)
アイコン画像ピョン
» 【DVDラベル】MAN WITH A MISSION -狼大全集V-  (2016年06月30日)