2024年3月25日月曜日

Excel VBA セルカーソルの移動

 Excel VBA セルカーソルの移動

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Debug.Print "Worksheet_SelectionChange(Byval Target As Range)"
    Dim returnLine As Integer
    Dim sline As Integer
    Dim eline As Integer
    Dim lastXup As Long
    sline = 3
    eline = 4
    '日付の入力
    If Cells(Target.Row, 3) <> "" Then
        dbCheck Target
    Else
        'Cells(Target.Row, 7) = ""
    End If
    'カーソルの移動
    If Target.Column > eline - 1 Then
        Cells(Target.Row + 1, sline).Activate
    End If
    If ActiveCell.Value = "" Then
        lastXup = Cells(Rows.Count, 3).End(xlUp).Row
        Cells(lastXup + 1, sline).Activate
    End If
End Sub

Excel VBA セル内容の読み上げ

Excel VBA セル内容の読み上げ 


Public Function spk(ByVal Target As Range)
    On Error GoTo Myerror
        If Not IsError(Target.Value) And TypeName(Target.Value) <> "Variant()" And Target.Value <> "" Then
            Dim arr() As String
            Dim i As Long
            Dim leng As Long
            leng = Len(Target.Value)
            ReDim arr(leng - 1)
            For i = 0 To leng - 1
                arr(i) = Mid(Target.Value, i + 1, 1)
            Next i
            For Each x In arr
                Select Case Asc(x)
                    Dim sv As String
                 Case 47 To 58
                    sv = "数字の "
                 Case 64 To 91
                    sv = "大文字の "
                 Case 96 To 123
                    sv = "小文字の "
                End Select
                Application.Speech.Speak sv & x, "True"
            Next x
        End If
Myerror:
        Debug.Print "Myerror"
End Function