Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150602101200]]
- #score: 9211
- @digest: e36e720447655b6c93f837134559155e
- @id: 68141
- @mdate: 2015-10-03T16:32:21Z
- @size: 19047
- @type: text/plain
- #keywords: thismon (58145), winform (49391), inidate (40403), dlabelinisub (38104), clsc (37632), ufmgleft (37491), lball (35799), lbbgcolor (29993), lbbdcolor (29993), lbwidth (29523), sz (20454), sdate (17583), calendar (16730), backcolor (6792), label (6652), msforms (6487), ラベ (5843), forms (5383), forecolor (5229), caption (4568), property (4452), withevents (4364), カレ (4068), system (3970), controls (3831), ベル (3520), ンボ (3316), メイ (3196), ボボ (2955), private (2946), イベ (2783), public (2732)
- 『ユーザーフォームにカレンダー』（yuki）
ユーザーフォームにカレンダーを設置することは可能でしょうか? アクセスは入っていないので、完全にエクセルだけで使えるようにしたいのですが。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- こんにちは excel ユーザーフォーム カレンダー とかでWEB検索すると自作の方法が見つかりますよ。 （ウッシ） 2015/06/02(火) 11:24 ---- シェルのウィンドウがチラッと表示されるのを何とかしたいですが、 お遊びで PowerShellを利用した例です。 Sub PowerShellCalender() Dim pss As String pss = "Function Get-Date {" _ & "[System.Reflection.Assembly]::LoadWithPartialName('System.windows.forms') | Out-Null;" _ & " $WinForm = New-Object Windows.Forms.Form;" _ & " $WinForm.Size = New-Object Drawing.Size(420,180);" _ & " $WinForm.text = 'Calendar Control';" _ & " $Calendar = New-Object System.Windows.Forms.MonthCalendar;" _ & " $Calendar.MaxSelectionCount = 356;" _ & " $Calendar.SetCalendarDimensions([int]3,[int]1);" _ & " $WinForm.Controls.Add($Calendar);" _ & " $WinForm.Add_Shown($WinForm.Activate());" _ & " $WinForm.showdialog() | Out-Null;" _ & " $Calendar.SelectionRange; }" _ & " $dates = Get-Date;" _ & " $tb = New-Object System.Windows.Forms.TextBox;" _ & " $tb.Text =($dates.Start).tostring('yyyy-MM-dd') + ',' + ($dates.End).tostring('yyyy-MM-dd');" _ & " $tb.SelectAll(); $tb.Copy();" CreateObject("WScript.Shell").Run "PowerShell -WindowStyle Hidden -Command " & pss, , True With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '// DataObject .GetFromClipboard If InStr(.GetText, ",") > 0 Then msg = Split(.GetText, ",") MsgBox "開始日:" & msg(0) & vbNewLine _ & "終了日:" & msg(1) Else MsgBox .GetText End If End With End Sub 正統派は多分こういった感じでしょうけれど・・・。 http://www.h3.dion.ne.jp/‾sakatsu/index.htm http://excel-2010.seesaa.net/article/154360048.html （Mook） 2015/06/02(火) 13:07 ---- 自分用に練習兼ねて作ったものを、配布用に色々削って提示します。 個人的には満足。 多分面倒だと思いますので、パッケージ化して配布されたツール使ったほうが早いです。 ラベルしかコントロール配列使っていないので、37個クリックイベント書けばクラス モジュールは不要です。 01)クラスモジュールを2つ挿入してください 02)それぞれ、下記の名前にしてください clsUFCalendarMain <--以降Mainと呼びます clsUFCalendarSub <--以降Subと呼びます 03)ユーザーフォームを追加してください（コントロールは必要ありません） 04)フォームの名前を UFCalendarSimple としてください 05)Mainに以下のコードを入れてください Option Explicit Event Click(ByVal ID As Long) '================================================== Private DIC As Object '================================================== '================================================== Private Sub Class_Initialize() '================================================== Set DIC = CreateObject("Scripting.Dictionary") End Sub '================================================== Private Sub Class_Terminate() '================================================== Me.Clear End Sub '================================================== '★Property Setで引数を二つにし、添え字でオブジェクトの代入ができるようにする Public Property Set Ctrl(ID As Long, obj As Object) '================================================== Dim clsObj As Object Set clsObj = New clsUFCalendarSub With clsObj .ID = ID .Method = "CallBackAndRaseEvent" Set .Parent = Me Set .obj = obj End With DIC.Add ID, clsObj End Property '================================================== Public Property Get Ctrl(ID As Long) As Object Set Ctrl = DIC(ID).obj End Property '================================================== '★子クラスのコールバック Public Sub CallBackAndRaseEvent(ParamArray arg() As Variant) Select Case arg(0) Case "Click": RaiseEvent Click(arg(1)) End Select End Sub '================================================== Public Sub Clear() '================================================== Set DIC = Nothing End Sub 06)Subに以下のコードを入れてください Option Explicit '============================================================ 'このクラスの疑似オブジェクトは『ラベル』 '============================================================ Public WithEvents obj As MSForms.Label '============================================================ '共通の設定 '============================================================ Public Parent As Object Public ID As Long Public Method As String '============================================================ 'イベント一覧 '============================================================ Private Sub obj_Click() CallByName Parent, Method, VbMethod, "Click", ID End Sub 07)フォームに以下のコードを追加してください Option Explicit Private WithEvents clsC As clsUFCalendarMain Private WithEvents CB As MSForms.ComboBox Private WithEvents SP As MSForms.SpinButton Private LB1(0 To 2) As MSForms.Label Private IniDate As Date '================================================== '列挙型 色を指定してください"&H00"と"BBGGRR"の組み合わせです。 Private Enum clr '================================================== '色（http://iro-color.com/colorchart/arrangement/system-blue.html） ufBGColor = CLng("&H00E9CCBB") 'ユーザーフォームの背景 lbBGColor = CLng("&H00F9EFEA") 'ラベルの背景 lbBDColor = CLng("&H00D29B6C") 'ラベルの罫線 nwBGColor = CLng("&H00DAAB88") '現在日付の背景 End Enum '================================================== '列挙型 各コントロールのサイズがあります。 Private Enum Sz '================================================== lbAll = 18 lbFont = 11.25 lbWidth = 42 cbWidth = 108 cbHeight = 27 cbFont = 14.25 spHeight = 24 spWidth = 18 ufMgLeft = 6 ufMgTop = 6 ctMgTop = 6 edMgLeft = 10 edMgTop = 30 End Enum '================================================== '【EV】ラベルのクリックイベント Private Sub clsC_Click(ByVal ID As Long) '================================================== Dim LB As MSForms.Label Set LB = clsC.Ctrl(ID) With LB If ID < 99 Then Selection.Value = CDate(Format(CB.Value & .Caption & "日", "yyyy/mm/dd")) Else Selection.Value = Date - (100 - ID) End If End With Unload Me End Sub '================================================== '【EV】イニシャライズイベント 引数を渡せないので、FormIniメソッドに渡す Private Sub UserForm_Initialize() '================================================== Dim i As Long mkCtrl '//コントロールにイベントを持たせるため、クラスに登録する Set clsC = New clsUFCalendarMain For i = 1 To 37 Set clsC.Ctrl(i) = Me.Controls("d" & Right("0" & i, 2)) Next i '//こちらは「昨日・今日・明日」のほう Set clsC.Ctrl(99) = LB1(0) Set clsC.Ctrl(100) = LB1(1) Set clsC.Ctrl(101) = LB1(2) End Sub '================================================== '【EV】EVターミネートイベント Private Sub UserForm_Terminate() '================================================== clsC.Clear Set clsC = Nothing End Sub '================================================== 'Showの代わりに、日付をセットする Public Sub FormIni(myDate As Variant) '================================================== If IsDate(myDate) Then IniDate = CDate(myDate) Else IniDate = Date End If DLabelIni Weekday(Format(IniDate, "yyyy/mm/01")), DateSerial(Year(Date), Month(Date) + 1, 0) YMCmbIni IniDate Me.Show vbModeless 'ユーザーフォームからフォーカスを外し、ワークシート選択状態にする AppActivate Application.Caption Application.ThisWorkbook.Activate End Sub '================================================== '★ラベルを書き換えるメインプロシジャー Private Sub DLabelIni(fd As Long, ed As Date) '================================================== Dim d As Long Dim i As Long Dim LB As MSForms.Label Dim ThisMon As Boolean ThisMon = Format(IniDate, "yyyymm") = Format(ed, "yyyymm") d = 1 'Labelコントロールを疑似オブジェクトにセットする For i = 1 To 37 Set LB = clsC.Ctrl(i) If d = 1 Then If i = fd Then DLabelIniSub LB, d, 1, True, ThisMon, d Else DLabelIniSub LB, d, 0, False, ThisMon, Day(CDate(Format(Date, "yyyy/mm/01")) - (fd - i)) End If ElseIf d <= Day(ed) Then DLabelIniSub LB, d, 1, True, ThisMon, d Else DLabelIniSub LB, d, 1, False, ThisMon, Day(ed + (d - Day(ed))) End If Next i End Sub '================================================== 'ラベルの日付を書き換えるサブプロシジャー Private Sub DLabelIniSub(ByRef LB As MSForms.Label, ByRef d As Long, ByVal Add As Long, ByVal Ena As Boolean, ByVal ThisMon As Boolean, ByVal Cap As String) '================================================== With LB .Enabled = Ena .Caption = Cap .BorderColor = clr.lbBDColor If ThisMon And Day(IniDate) = d Then .BackColor = clr.nwBGColor Else .BackColor = clr.lbBGColor End If d = d + Add End With End Sub '================================================== 'コンボボックスの値が変更になったら、ラベルの日付を書き換える Private Sub cb_Change() '================================================== Dim SDate As Date With CB SDate = DateValue(.Value) DLabelIni Weekday(SDate), DateSerial(Year(SDate), Month(SDate) + 1, 0) '★ End With End Sub '================================================== 'コンボボックスのリストを設定する SDateを基準日に、前後24カ月 Private Sub YMCmbIni(ByVal SDate As Date) '================================================== Dim i As Long For i = -24 To 24 CB.AddItem Format(DateSerial(Year(SDate), Month(SDate) + i, 1), "yyyy年m月") Next i CB.Value = Format(Date, "yyyy年m月") End Sub '================================================== 'スピンボタンの設定 押すとコンボボックスの値が前になる Private Sub sp_SpinDown() '================================================== With CB .ListIndex = Application.Max(.ListIndex - 1, 0) End With End Sub '================================================== 'スピンボタンの設定 押すとコンボボックスの値が先になる Private Sub sp_SpinUp() '================================================== With CB .ListIndex = Application.Min(.ListIndex + 1, .ListCount - 1) End With End Sub '================================================== 'フォームのフォーマットを作成する Private Sub mkCtrl() '================================================== Dim i As Long Dim LB2 As MSForms.Label Dim wkNum As Long Dim lbNam As String 'コンボボックスの設定 Set CB = Me.Controls.Add("Forms.ComboBox.1", "ComboBox1", True) With CB .Top = Sz.ufMgTop .Left = Sz.ufMgLeft .Height = Sz.cbHeight .Width = Sz.cbWidth .Font.Name = "メイリオ" .Font.Size = Sz.cbFont End With 'スピンボタンの設定 Set SP = Me.Controls.Add("Forms.SpinButton.1", "SpinButton1", True) With SP .Top = Sz.ufMgTop .Left = Sz.ufMgLeft + Sz.cbWidth .Height = Sz.spHeight .Width = Sz.spWidth .Orientation = fmOrientationVertical End With 'ラベル（昨日今日明日）の設定 For i = 0 To 2 Set LB1(i) = Me.Controls.Add("Forms.Label.1", "cl" & Split("Yesterday,Today,Tommorow", ",")(i), True) With LB1(i) .BackColor = clr.lbBGColor .BorderStyle = fmBorderStyleSingle .BorderColor = clr.lbBDColor .Top = CB.Top + Sz.cbHeight + Sz.ctMgTop .Left = Sz.lbWidth * i + Sz.ufMgLeft .Height = Sz.lbAll .Width = Sz.lbWidth .TextAlign = fmTextAlignCenter .Font.Name = "メイリオ" .Font.Size = Sz.lbFont Select Case i Case 0 .ForeColor = vbBlue .Caption = "昨日" Case 1 .ForeColor = vbBlack .Caption = "今日" Case 2 .ForeColor = vbRed .Caption = "明日" End Select End With Next i 'ラベル（日にち）の設定 wkNum = 7 lbNam = "" For i = 1 To 37 + wkNum If i <= wkNum Then lbNam = Split(",Sun,Mon,Tue,Wsd,Thu,Fri,Sat", ",")(i) Else lbNam = "d" & Right("0" & i - wkNum, 2) End If Set LB2 = Me.Controls.Add("Forms.Label.1", lbNam, True) With LB2 .BackColor = clr.lbBGColor .BorderStyle = fmBorderStyleSingle .BorderColor = clr.lbBDColor .Top = Sz.lbAll * (Application.WorksheetFunction.Ceiling(i / 7, 1) - 1) + LB1(2).Top + Sz.lbAll + Sz.ctMgTop .Left = Sz.lbAll * ((i - 1) Mod 7) + Sz.ufMgLeft .Height = Sz.lbAll .Width = Sz.lbAll .TextAlign = fmTextAlignCenter .Font.Name = "メイリオ" .Font.Size = Sz.lbFont If i < 8 Then .Caption = Split("日,月,火,水,木,金,土", ",")(i - 1) Else .Caption = i - 7 .MousePointer = fmMousePointerCross End If Select Case i Mod 7 Case 1: .ForeColor = vbRed Case 0: .ForeColor = vbBlue End Select End With Next i With Me .Width = LB1(2).Left + Sz.lbWidth + Sz.edMgLeft .Height = LB2.Top + Sz.lbAll + Sz.edMgTop .Caption = "カレンダー" .BackColor = clr.ufBGColor End With End Sub 08)呼び出し方法は以下の通りです。 Sub HowToUse() UFCalendarSimple.FormIni Date End Sub ユーザーフォームの日付や「今日・明日」等のラベルをクリックすると、 現在選択しているセルに日付が入力されます。 必要に応じて、selection_Changeイベントなどと組み合わせて使ってください。 特定のセルに日付を入力させたい場合は、フォームのプロシジャー '================================================== '【EV】ラベルのクリックイベント Private Sub clsC_Click(ByVal ID As Long) '================================================== のSelection.Valueを調整してください。 （稲葉） 2015/06/02(火) 13:48 ---- 選択範囲の開始と終了を表示するようにちょっと上のコードを修正。 （Mook） 2015/06/02(火) 18:58 ---- カレンダーでは、この学校内の以下 [[20100728102355]] 調べてみてください。 発端は、ラベルの垂直線上の中央揃えの方法だったのですが、 これが以外な方法で実現できるというスレッドです。 ここで nagashimaさんという方がこれを使ったカンレダーを紹介されています。 カレンダーを二つのクラスモジュールで管理しています。 私が少し使った限り、良いところは、 フレームを作成した大きさにカレンダーを作成します。 つまり、ユーザーフォーム上にフレームを配置することにより、フレームと同じ位置、大きさにカレンダーを 作成することが出来ます。 提供しているイベントは クリックとダブルクリック ラベルの垂直線上の中央揃えの方法が前半に記述されていますから、この施しをしなければなりません。 じっくり読んでいけば 理解いただけるはずです。 改良点 他人が作ったコードですし、又非常に良いコードなので これに難を申し上げるのは気が引けますが、 ラベルを中央ぞろえするために 簡単な bmpファイルを用意しなければなりませんが、これも コードで実現するとより良くなると思うこと。 祝日もカレンダー内で管理していますが、祝日無のモードも用意しておいた方が安心なこと なんてことが私の感想ですが、良い仕様だと感じましたので ご紹介させていただきます。 （ichinose） 2015/06/02(火) 22:18 ---- 遅くなりましたがMookさん、稲葉さん、ichinoseさん、ありがとうございました。大変参考になります。 びっくりして声が出ませんでした。感激です!是非使用させていただきます。本当にありがとうございました。 （yuki） 2015/06/03(水) 13:20 ---- 稲葉さま 突然失礼いたします。 非常に便利で、あり難く使わせて頂いております。 一つ確認したいことがあり、起票させて頂きました。 本来であれば、別スレッドを立ち上げるべきかもしれませんが。 カーソル 現在は、カーソルが、”+ ”になっていますが このカーソルを、通常の矢印等に変えることは可能でしょうか もし可能なのであれば、どの部分をリメイクすればよろしいのでしょうか ご教示頂きたくお願い申し上げます。 （aki） 2015/10/03(土) 20:57 ---- 横から失礼します。 便利なコードですねぇ。 全部に目を通してはいませんが MousePointer プロパティに fmMousePointerCross をセットしているところがありますよね。 このプロパティで、様々な形状を指定できます。 http://excwlvba.blogspot.jp/2013/05/userform_8.html あたりがわかりやすいかも。 （β） 2015/10/03(土) 21:36 ---- βさま ありがとうございました。 ばっちりです! 今後とも宜しくお願い申し上げます。 （aki） 2015/10/04(日) 01:32... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201506/20150602101200.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97000 documents and 607841 words.
訪問者：