【Python】OCR

#OCR

#引数：フォルダ py *.py "C:\"

#pip install easyocr

import os

import sys

import easyocr

 

if __name__ == '__main__':

args = sys.argv

print(args[1])

path = os.path.join(args[1], "cap.png")

dest_path = os.path.join(args[1], "cap.csv")

 

reader = easyocr.Reader(['ja','en']) 　#文字の選択一回だけでいい

txts = reader.readtext(path, detail=0) #文章のみ

 

with open(dest_path, 'w', newline='', encoding = "utf-8") as fw:

    for txt in txts:

        fw.write("%s\n" % txt)

 

【Excel】ツール作成で注意すること

＜シート＞

入力規則は使わないようにする

リストはり使わないようにする

動的な変数はなるべく 使用せずに設定から値を取るようにする

複雑（長文）な式は使用しない

＜VBA＞

 複雑な公式は使用しない

起動プログラム（ThisWookbook） はなるべく 使用しない

SETをしたら必ずnothingをする

＜ネットワーク経由＞

更新処理は行わないようにする

アップロードを行わないようにする（ダウンロードは可）

＜注意＞

長いパス

リストの256文字超過

同じファイル名での削除と作成

【VBA】CSVエクスポート UTF-8

Sub ExportSrt_101_01(argFldrPath As String, argFileName As String, argTransId As Long)

    Dim cn2 As ADODB.Connection
    Dim rss2 As ADODB.Recordset
    Dim strSql2 As String
    Dim buf As String
    Dim bufLine As String
    Dim lines
    Dim line As Variant  ' For Each用の一時変数
    Dim iLen As Integer
    Dim vbLfFlg As Boolean
    
    Dim filePath As String
    Dim fileName As String
    
    Dim objUTF8
    Dim objUTF8NoBOM
    Dim OutputLines() As String
    Dim lineSeprator As Long  ' 改行コードを格納する変数

    Const TypeBinary = 1
    Const WriteLine = 1
    Const lineSeparatorLF = 10
    
    Set objUTF8 = CreateObject("ADODB.Stream")       'UTF8(BOM)ありのストリーム
    Set objUTF8NoBOM = CreateObject("ADODB.Stream")
    
    lineSeprator = lineSeparatorLF
    fileName = argFileName
    
    'テキストファイルに出力
    filePath = argFldrPath & "\" & fileName

    'cn　カレントDB指定
    Set cn2 = Application.CurrentProject.Connection
    Set rss2 = New ADODB.Recordset

    'テーブルのデータ作成
    tbls = "テーブル"
    strSql2 = ""
    strSql2 = _
            "SELECT trans_id, trans_no, file_id, trans_file_name, trans_japan, trans_change_no" & _
            " FROM " & tbls & _
            " WHERE trans_id = " & argTransId & _
            " ORDER BY trans_id, trans_no"
            
    rss2.Open strSql2, cn2, adOpenForwardOnly, adLockReadOnly
    
    iLen = 30
    
    With rss2
        buf = ""
        Do Until .EOF
            vbLfFlg = False
            bufLine = ""
            If IsNull(!trans_japan) Then
                bufLine = ""
            Else
                bufLine = !trans_japan
            End If
            
            '改行
            If !trans_change_no = 3 And _
                (Len(bufLine) > iLen) And _
                (InStr(bufLine, "、") <> 0 Or InStr(bufLine, "。") <> 0) Then
                
                bufLine = GetIndentionText(bufLine, "。", iLen)
                buf = buf & bufLine
                vbLfFlg = True
            ElseIf InStr(bufLine, "/-") <> 0 Then
                bufLine = GetIndentionText(bufLine, "/", iLen)
                bufLine = Replace(bufLine, "/", "")
                buf = buf & bufLine
                vbLfFlg = True
            Else
                buf = buf & bufLine & vbLf
            End If
'Debug.Print "buf:" & buf
            
            If vbLfFlg = True Then
                buf = buf & vbLf
            End If

            .MoveNext
        Loop
        .Close
    End With
    
    cn2.Close
    Set rss2 = Nothing
    Set cn2 = Nothing
                
    lines = Split(buf, vbLf)
    
    With objUTF8
        .Charset = "UTF-8"
        .LineSeparator = lineSeprator
        .Open
    
        For Each line In lines
            .WriteText line, WriteLine
        Next
        
        .position = 3
    End With
    
    With objUTF8NoBOM
        .Type = TypeBinary
        .Open
        objUTF8.CopyTo objUTF8NoBOM
        .SaveToFile filePath, 2
    End With

    objUTF8.Close
    objUTF8NoBOM.Close
   
End Sub

【VBA】データ内にカンマが含まれているCSVファイルの取り込み

'データ内にカンマが含まれているCSVファイルの取り込み

Sub GetCSVCamma()

    Dim filePath As String
    Dim F As Integer
    Dim strLine As String
    Dim strField As Variant
    
    filePath = "C:\Users\XXX\基準2.csv"

    F = FreeFile()
    Open filePath For Input As #F
    Line Input #F, strLine
    
    Do Until EOF(F)
        'データを1行読み込む
'        Input #F, strField(0), strField(1), strField(2), strField(3)
        Line Input #F, strLine
        
        If CsvChackComma(strLine) = False Then
            strLine = RreplaceSymbol(strLine)
            strField = Split(Replace(strLine, """", ""), "$;$")
        Else
            strField = Split(Replace(strLine, """", ""), ",")
        End If
    Loop

    Close #F

End Sub

'CSVファイルの取り込み　データ内にカンマが含まれているかチェック
Function CsvChackComma(argStrLine As String) As Boolean

    Dim buf As String
    Dim strChar As String
    Dim quotCnt As Long
    Dim charCnt As Long
    
    buf = argStrLine
    strChar = ","
    charCnt = Len(buf) - Len(Replace(buf, strChar, ""))
'    MsgBox charCnt & "は" & charCnt & "個あります"
    
    strChar = """"
    quotCnt = Len(buf) - Len(Replace(buf, strChar, ""))
'    MsgBox quotCnt & "は" & quotCnt & "個あります"

    If ((charCnt * 2) + 2) Mod quotCnt = 0 Then
        CsvChackComma = True
    Else
        CsvChackComma = False
    End If

End Function

'受け取った文字列のカンマを$;$に置き換える
'ダブルクォーテーションで囲まれているカンマは置き換えない
Function RreplaceSymbol(argLine As String) As String

    Dim buf As String
    Dim strLine As String
    Dim i As Long
    Dim quotCnt As Long

    
    strLine = argLine
    For i = 1 To Len(strLine)
        buf = Mid(strLine, i, 1)
        
        If buf = """" Then
            quotCnt = quotCnt + 1
        ElseIf buf = "," Then
            If quotCnt Mod 2 = 0 Then

               strLine = Left(strLine, i - 1) & "$;$" & Right(strLine, Len(strLine) - i)  

            End If
        End If
    Next i

    RreplaceSymbol= strLine

End Function

【VBA】ファイル

'ファイルを一括でコピー
'引数：CopyFileAll(フォルダーパス & "\*.csv", フォルダーパス)
Sub CopyFileAll(argTargetWildFilePath As Variant, argDestFolderPath As Variant)
    
    Dim objFso As New FileSystemObject
    
    With objFso
        'ファイルを一括でコピー
        objFso.CopyFile argTargetWildFilePath, argDestFolderPath
    End With

End Sub

【ACCESS】ファイル更新日付チェック。ファイルが更新されていた場合、更新フラグをtrueにする

'ファイル更新日付チェック。ファイルが更新されていた場合、更新フラグをtrueにする。
Sub ChackCreateDate()

    'File変数
    Dim objFso As New FileSystemObject
    Dim objFolder As Object
    Dim objFiles As Object
    Dim objFile As file
    Dim objDate As Date
    Dim lastDate As String
    Dim folderPath As String
    
    Dim cn As ADODB.Connection
    Dim rsi As ADODB.Recordset
    Dim tbli As String
    Dim strSql As String
    Dim fileCnt As Integer, destFileCnt As Integer
    Dim chkFlg As Integer
    Dim chkMsg As String
    
    'cn　カレントDB指定
    Set cn = Application.CurrentProject.Connection
    Set rsi = New ADODB.Recordset
    Set objFso = New FileSystemObject
    
    tbli = "テーブル1"
    strSql = "SELECT * FROM " & tbli & " WHERE マスタフラグ = true"
    rsi.Open strSql, cn, adOpenDynamic, adLockOptimistic
    
    While Not rsi.EOF
        
        chkFlg = True
        chkMsg = ""
        folderPath = rsi![ファイルパス]
        lastDate = rsi![最終更新日]
        fileCnt = rsi![ファイル数]
        
        Set objFolder = objFso.GetFolder(folderPath)
        Set objFiles = objFso.GetFolder(folderPath).Files
        
        For Each objFile In objFiles
            '作成日時を取得
            objDate = objFile.DateCreated
            Debug.Print (objDate)
            
            If CStr(objDate) > lastDate Then
                '指定したフォルダ内のファイル数を取得する then
                destFileCnt = objFso.GetFolder(folderPath).Files.Count
                'ファイル件数チェック
                If fileCnt <> 0 And fileCnt <> destFileCnt Then
                    chkMsg = chkMsg & "ファイル数(" & destFileCnt & "ファイル)が規定数(" & fileCnt & "ファイル)合いません。"
                    chkFlg = False
                Else
                    chkMsg = "ファイルが最新です。"
                    chkFlg = True
                End If
            Else
                chkFlg = False
            End If
            
            Exit For
        Next objFile

        rsi![更新フラグ] = chkFlg
        rsi![メッセージ] = chkMsg
        rsi.Update
        rsi.MoveNext
        
        Set objFiles = Nothing
        Set objFolder = Nothing
    Wend

    rsi.Close
    cn.Close

    Set rsi = Nothing
    Set cn = Nothing
    Set objFso = Nothing
        
End Sub

【Excel】クリップボード

'クリップボード取得
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Call SetClipBoard(ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column))

End Sub

Option Explicit
'クリップボード
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

'【使用方法】
'以下をシートのモジュールに貼り付ける
Sub SetClipBoard(argBuf As String)

    Dim objCB As New DataObject
    
    With objCB
        .SetText argBuf        '変数のデータをDataObjectに格納する
        .PutInClipboard         'DataObjectのデータをクリップボードに格納する
    End With
    
End Sub