Instantly share code, notes, and snippets.
Last active
April 29, 2021 01:14
-
Star
(0)
0
You must be signed in to star a gist -
Fork
(0)
0
You must be signed in to fork a gist
-
Save muramoto1041/bfe8273128b78201268db74951214496 to your computer and use it in GitHub Desktop.
Fy_メニュー
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'**************************************************************** | |
'作成日:2020/06/01 | |
' Fy_メニュー | |
'作成者:村本俊和 | |
'**************************************************************** | |
Option Explicit | |
'System | |
Dim sMsg As Integer | |
Dim sWhere As String | |
'Procedure | |
Dim sTitle As String | |
Dim sMenuList As String | |
Dim sStrMsg As String | |
Dim sMenuNo As Integer | |
'YUGEコマンド | |
Dim sCommand As String | |
Dim sクリック表示 As String | |
'2020/05/10 --------------------------------------------------* | |
Private Sub UserForm_Initialize() | |
On Error GoTo subError | |
'--- FormSize --- | |
Me.Height = Me.HRheight.Height + 30 | |
Me.Width = Me.HRwidth.Width + 15 | |
ygEnd = 0 | |
sTitle = ygSTR1 | |
sMenuList = ygSTR2 | |
sStrMsg = ygSTR3 | |
sMenuNo = ygInt1 | |
'YUGEコマンド | |
sCommand = "" | |
Call s_MenuList(sMenuList) | |
'タイトル | |
If sTitle <> "" Then | |
'YUGE内Call | |
If Left(sTitle, 1) = "$" And Right(sTitle, 1) = "$" And Len(sTitle) > 2 Then | |
sTitle = Mid(sTitle, 2, Len(sTitle) - 2) | |
sCommand = sTitle | |
Select Case sCommand | |
Case "シートメニュー": sクリック表示 = ygSTR4 'する、しない | |
End Select | |
End If | |
Me.Caption = sTitle | |
End If | |
'メッセージ | |
Me.lblMsg.Caption = sStrMsg | |
subExit: | |
Exit Sub | |
subError: | |
MsgBox Error$ & "(#" & Trim(Trim(Err.Number)) & ")", vbOKOnly + vbExclamation _ | |
, "確認 : FormIni" | |
Resume Next | |
End Sub | |
'2020/06/01 --------------------------------------------------* | |
Private Sub s_MenuList(qMenuList As String) | |
Dim wNO As Integer | |
Dim wMenuStr As String | |
If qMenuList = "" Then Exit Sub | |
Do | |
wNO = wNO + 1 | |
wMenuStr = fy対応文字列(qMenuList, wNO) | |
If wMenuStr = "" Then Exit Do | |
Me.lstMenu.AddItem wMenuStr | |
Loop | |
If sMenuNo > 0 And sMenuNo < wNO Then | |
Me.lstMenu.Selected(sMenuNo - 1) = True | |
End If | |
End Sub | |
'2020/07/19 --------------------------------------------------* | |
Private Sub lstMenu_Click() | |
' | |
'YUGEコマンド【シートメニュー】 | |
'メニューをクリックするとシートを表示する。 | |
' | |
On Error GoTo subError | |
Dim wMenu As String | |
Dim wNO As Integer | |
Dim wCnt As Integer | |
If Not (sCommand = "シートメニュー" And (sクリック表示 = "する" Or sクリック表示 = "")) Then Exit Sub | |
wCnt = Me.lstMenu.ListCount | |
For wNO = 0 To wCnt - 1 | |
If Me.lstMenu.Selected(wNO) = True Then | |
wMenu = Me.lstMenu.List(wNO) | |
Exit For | |
End If | |
Next wNO | |
'シート表示 | |
n = f_シート表示(wMenu, "") | |
subExit: | |
Exit Sub | |
subError: | |
MsgBox Error$ & "(#" & Trim(Trim(Err.Number)) & ")", vbOKOnly + vbExclamation _ | |
, "確認 : lstMenu" | |
Resume subExit | |
End Sub | |
'2020/05/10 --------------------------------------------------* | |
Private Sub cmd選択_Click() | |
On Error GoTo subError | |
Dim wMSG As String | |
Dim wMenu As String | |
Dim wNO As Integer | |
Dim wCnt As Integer | |
wCnt = Me.lstMenu.ListCount | |
sMenuNo = 0 | |
For wNO = 0 To wCnt - 1 | |
If Me.lstMenu.Selected(wNO) = True Then | |
wMenu = Me.lstMenu.List(wNO) | |
sMenuNo = wNO + 1 | |
Exit For | |
End If | |
Next wNO | |
If sMenuNo = 0 Then | |
wMSG = "メニューを選択してください。" | |
MsgBox wMSG, vbOKOnly + vbExclamation, "確認" | |
Exit Sub | |
End If | |
ygEnd = 1 | |
ygInt1 = sMenuNo | |
Unload Me | |
subExit: | |
Exit Sub | |
subError: | |
MsgBox Error$ & "(#" & Trim(Trim(Err.Number)) & ")", vbOKOnly + vbExclamation _ | |
, "確認 : 選択" | |
Resume subExit | |
End Sub | |
'2020/07/20 --------------------------------------------------* | |
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment