579 式コピー (特殊コピー)
前回、紹介の「汎用マクロ ユーザフォーム」の実際の表示位置は上記の通り。(手動でポインターでユーザーフォームりタイトル部分をつかんで、位置を動かすこと可能)式コピーボタンは、オブジェクト名は自動で命名されるCommandButton1 で、以下のように「式コピー」マクロを設定する。式コピーマクロを取り急ぎ、下記。機能や使い方は次回以降に説明の予定だが、「式コピー」ではPulblic変数 P_Siki を利用している。Sub 式コピー()Dim rng As Range, cell As Range If ActiveCell.Address = Selection.Cells(1).Address And _ Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then syori_num% = 0 ElseIf Selection.Rows.Count * Selection.Columns.Count = 4 And _ Selection.Rows.Count = 2 And Selection.Columns.Count = 2 Then For i% = 1 To 4 If ActiveCell.Address = Selection.Cells(i%).Address Then syori_num% = i% Next ElseIf ActiveCell.Address = _ Selection.Cells(Selection.Rows.Count * Selection.Columns.Count).Address Then syori_num% = 5 End If Set rng = Selection Select Case syori_num% Case 0: P_Siki = ActiveCell.Formula Case 1: P_Siki = ActiveCell.Formula ActiveCell.ClearContents On Error GoTo end_line Selection.Offset(-1, 0).Select On Error GoTo 0 Case 2: If Len(ActiveSheet.Name) < 3 Then MsgBox ("シート名の長さが 3 未満のため、処理中止") Exit Sub End If If Right(ActiveSheet.Name, 3) = "(旧)" Then ActiveSheet.Name = Mid(ActiveSheet.Name, 1, Len(ActiveSheet.Name) - 3) Else ActiveSheet.Name = ActiveSheet.Name & "(旧)" End If Case 3: P_Siki = ActiveSheet.Name Selection.Cells(2).Activate Case 4: P_Siki = ActiveSheet.Tab.Color Case 5: P_Siki = "" For Each cell In rng If cell.Column = rng.Cells(rng.Columns.Count).Column Then P_Siki = P_Siki & cell & Chr(10) Else P_Siki = P_Siki & cell & " " End If Next P_Siki = Mid(P_Siki, 1, Len(P_Siki) - 1) Tmp_Siki$ = P_Siki 'P_Siki For i% = Len(Tmp_Siki$) To 1 Step -1 If Mid(Tmp_Siki$, i%, 1) = Chr(10) Then Tmp_Siki$ = Left(Tmp_Siki$, i% - 1) Else Exit For End If Next '改行文字(Chr(10))が連続する場合は改行文字を1文字に詰める処理 If Len(Tmp_Siki$) = 1 Then Exit Sub '非セルズ1アクティブのため '文字長は2以上になる筈だが '念のためのチェックEndトラップ Tmp_str$ = Left(Tmp_Siki$, 1) PrtLst_Ltr$ = Left(Tmp_Siki$, 1) For i% = 2 To Len(Tmp_Siki$) - 1 If PrtLst_Ltr$ = Chr(10) And Mid(Tmp_Siki$, i%, 1) = Chr(10) Then Else Tmp_str$ = Tmp_str$ & Mid(Tmp_Siki$, i%, 1) PrtLst_Ltr$ = Right(Tmp_str$, 1) End If Next If Not (Mid(Tmp_Siki$, Len(Tmp_Siki$), 1) = Chr(10) And _ Mid(Tmp_Siki$, Len(Tmp_str$), 1) = Chr(10)) Then Tmp_str$ = Tmp_str$ & Right(Tmp_Siki$, 1) End If P_Siki = Tmp_str$ End SelectGoTo stndrd_end_lineend_line: MsgBox ("シート名の重複等のエラー")stndrd_end_line:End Sub©みさき式エクセルマクロ2022