[[20240831173024]] 『VBAからSVGファイルへの書き込みについて』(空腹) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAからSVGファイルへの書き込みについて』(空腹)

ChatGTPで作ったコードででるエラーの解決方法を質問ですので
不快に思われる方がいましたらすみません

SVGファイルという画像を文字列にしてあるファイルがあります
(ご存知かもしれませんが、テキストで編集すると、コードで画像がかけます)
bm.svg の文字列のうち
"追記” という文字列をA1で置き換え、bm1.svgとして保存したくて
ChatGTPで生成しると以下のコードになりました

Sub ReplaceAndSaveSVG()

    Dim filePath As String
    Dim newFilePath As String
    Dim searchText As String
    Dim replaceText As String
    Dim fileContent As String
    Dim fileNumber As Integer

    ' ファイルパスと新しいファイル名
    filePath = "C:\Users\aaa\Desktop\SVG\bm.svg"
    newFilePath = "C:\Users\aaa\Desktop\SVG\bm1.svg"

    ' セルA1から置き換え文字列を取得
    replaceText = ThisWorkbook.Sheets(1).Range("A1").Value

    ' SVGファイルを読み込む
    fileNumber = FreeFile
    Open filePath For Input As #fileNumber
    fileContent = Input$(LOF(fileNumber), fileNumber)
    Close #fileNumber

    ' 置き換え処理
    searchText = "追記"
    fileContent = Replace(fileContent, searchText, replaceText)

    ' 新しいSVGファイルとして保存
    fileNumber = FreeFile
    Open newFilePath For Output As #fileNumber
    Print #fileNumber, fileContent
    Close #fileNumber

    MsgBox "ファイルの置き換えと保存が完了しました。"
End Sub

上記を実行すると

実行エラー62
ファイルにこれ以上データがありません。

というエラーがでます。ファイルパスやファイルを開きっぱなしといったこともありません
どのようにしたらできるでしょうか?
よろしくお願いいたします

< 使用 Excel:Excel2019、使用 OS:Windows10 >


 ↓こんなのがあったっす。
ChatGPTにExcelVBAを習ったら試行錯誤がぱねェ(テキストの読み込み他 #ポエム - Qiita
https://qiita.com/query1000/items/bed1f6d4c24acad4e8bf

 まぁ、ホントにそれだけの話なのか? とも思いますが... ^^;

 私はOpenとかInputとか、あまりにも扱い難過ぎて実務で一度も使った事がないので、
 技術的にこれ以上大した助言は出来ません。

 結局テキストファイルを操作するだけってんなら、
 他にも幾つか方法はあるのではないかと思います。

(白茶) 2024/08/31(土) 20:06:19


 以下でどうでしょう?

 Sub SvgReplaceText()
    Const encode$ = "utf-8"
    Dim filename$
    filename = Application.GetOpenFilename(FileFilter:="svgファイル,*.svg")
    If filename = "False" Then Exit Sub
    '「追記」という文字列をSheets(1)の[A1]に置換
    Call SvgReplaceTextBase("追記", Sheets(1).Range("A1").Value, filename, encode)
 End Sub
 Private Sub SvgReplaceTextBase(ByVal findText$, ByVal replaceText$, ByVal path$, ByVal enc$)
    Dim stream As Object, strBefore$, strAfter$
    On Error GoTo ErrorProc
    Set stream = CreateObject("ADODB.Stream")
    With stream
        .Charset = enc
        .Open
        .LoadFromFile path
        strBefore = .ReadText
        .Close
        strAfter = VBA.Replace(strBefore, findText, replaceText)
        If strBefore = strAfter Then MsgBox "置き換える文字はありません!", vbCritical: Exit Sub
    End With
    With stream
        .Open
        .WriteText strAfter, 0
        .SaveToFile path, 2
        .Close
    End With
    MsgBox "ファイルの置き換えと保存が完了しました。", vbInformation
    Exit Sub
ErrorProc:
    If Not stream Is Nothing Then
        If stream.State <> 0 Then stream.Close
    End If
    MsgBox "ファイルの置き換えと保存に失敗しました。", vbCritical
End Sub
(まる2021) 2024/08/31(土) 20:13:15

 >bm1.svgとして保存したくて
 これ、見落としてました。別名で保存するなら

 .SaveToFile path, 2 を
 .SaveToFile "C:\Users\xxxx\Desktop\bm1.svg", 2 のように保存先のフルパスを指定してください。

 あと、文字コードは「utf-8」前提としています。
(まる2021) 2024/08/31(土) 20:25:23

(まる2021) 様 2024/08/31(土) 20:13:15

大成功!。。。(*^^*)v   テスト代行

excel 2016
os win10
インクスケープ[文字コードUTF-8]で作成した
 追記 と書いたテキストと 適当に図形置いた svg使用

m(__)m

(隠居Z) 2024/08/31(土) 20:31:42


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.