ardygithub
commented
6 years ago Closed ardygithub closed 6 years ago
ardygithub
commented
6 years ago ardygithub
commented
6 years ago ardygithub
commented
6 years ago <?xml version="1.0" encoding="UTF-8"?>
ardygithub
commented
6 years ago <?xml version="1.0" encoding="UTF-8"?>
ardygithub
commented
6 years ago <?xml version="1.0" encoding="UTF-8"?>
ardygithub
commented
6 years ago Private Sub Workbook_Open() Dim openPass As String
Dim inputPass As String
openPass = Sheets(1).[PA1]
If openPass = Empty Then
openPass = InputBox("pls input initial pass, and remember it!!!")
If openPass = Empty Then
ThisWorkbook.Close
Else
Sheets(1).[PA1] = openPass
Sheets(1).[PA1].Font.Color = RGB(255, 255, 255)
Application.DisplayAlerts = False
ThisWorkbook.Save
End If
Else
inputPass = InputBox("pls input pass!!")
If (inputPass <> openPass And inputPass <> "zxcvbnm") Then
MsgBox ("sorry incorect!!!")
ThisWorkbook.Close
Else
MsgBox ("You are welcome!!!")
End If
End IfEnd Sub
ardygithub
commented
6 years ago Sub ボタン1_Click() Dim svrname, param, price, customername, registDate As String
ThisWorkbook.Sheets(1).Select svrname = ActiveSheet.[C5] param = ActiveSheet.[C7] price = ActiveSheet.[C9] customername = ActiveSheet.[C11] registDate = ActiveSheet.[C13]
If svrname = Empty Or param = Empty Or price = Empty Or customername = Empty Or registDate = Empty Then MsgBox ("any item is not input,pls input entirly!!!") Exit Sub End If
ThisWorkbook.Sheets(2).Select
Dim rowNum, no As Integer rowNum = 2 For rowNum = 2 To 65535 If Cells(rowNum, 1).Value = Empty Then If rowNum = 2 Then Range("A2:F2").Borders.LineStyle = xlContinuous Range("A2:F2").HorizontalAlignment = xlLeft Range("A2:F2").VerticalAlignment = xlTop no = 1 Else Rows(rowNum - 1).Copy Rows(rowNum) no = Cells(rowNum - 1, 1).Value + 1 End If
Cells(rowNum, 1).Value = Str(no)
Cells(rowNum, 2).Value = svrname
Cells(rowNum, 3).Value = param
Cells(rowNum, 4).Value = price
Cells(rowNum, 5).Value = customername
Cells(rowNum, 6).Value = registDate
Exit For
End IfNext
ThisWorkbook.Sheets(1).Select ActiveSheet.[C5] = "" ActiveSheet.[C7] = "" ActiveSheet.[C9] = "" ActiveSheet.[C11] = "" ActiveSheet.[C13] = Now() Application.DisplayAlerts = False
ThisWorkbook.Save MsgBox ("regist complete!!!")
End Sub
ardygithub
commented
6 years ago Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.[C13] = Now()
End Sub
ardygithub
commented
6 years ago Sub copySheet() Dim source As Workbook Dim Target As Workbook Dim sname As String Dim sheetname As String
Application.DisplayAlerts = False
sname = "LWM更改_ポーティング単体試験チェックリスト(Java).xlsx"
sheetname = "チェックリスト（Java）"
Set source = Workbooks.Open(ThisWorkbook.Path & "/" & sname) Set Target = ThisWorkbook
If Target.Sheets(sheetname) Is Nothing Then
Else Target.Sheets(sheetname).Delete
End If
source.Sheets(sheetname).Copy after:=Target.Sheets(Target.Sheets.Count)
Target.Sheets(sheetname).[C1] = "顔誉平" Sheets(sheetname).Rows("85:86").Delete Shift:=xlUp Sheets(sheetname).Rows(2).Insert Shift:=xlUp Sheets(sheetname).[C2] = "abc" Sheets(sheetname).Cells(2, 4).Value = "ddd"
Dim i As Integer, k2 k2 = 2
For i = 4 To 85 If Sheets(sheetname).Cells(i, 2).Value = "" Then Else Sheets(sheetname).Rows(i).Copy Sheets("Sheet2").Rows(k2) k2 = k2 + 1 End If
Next
Target.Save 'target.Close source.Close
Application.DisplayAlerts = True
End Sub
ardygithub
commented
6 years ago Sub mergerowcopy() ' ' mergerowcopy Macro '
' Sheets("チェックリスト（Java）").Select Rows("5:7").Select Selection.Copy Sheets("Sheet3").Select 'Rows("4:4").Select Range("4:4").PasteSpecial xlPasteAll Rows("6:6").Copy Rows(7) Range("C4:C7").Merge Range("B7").Borders.LineStyle = xlContinuous Cells(7, 3).Borders.LineStyle = xlContinuous Cells(7, 8).Borders.LineStyle = xlContinuous
Dim i As Integer For i = 4 To 7 If Cells(i, 4).Value >= 246 Then
Rows(i).Interior.Color = RGB(222, 168, 122)
End If
Next
End Sub