1

コピーするセル - ファイル パスを作成します

これに追加の画像を追加しました。DocType 列は、[Doc Types] シートからこのシートに自動的にコピーされます。コンテンツは、入力されるセルの数によって変化し、変動する可能性があります。したがって、式は最初の列を作成します。次に、vb を使用してファイル パス列の結果を評価し、"C:\test\images\tester.TIF"そこに作成されたファイル パスに必要な回数をコピーする必要があります。私が現在持っている以下のコードははるかに単純ですが、これをどの方向に進めるべきかわかりません。

    サブコピーEmTWO()
        Dim ws As ワークシート
        Dim strIn As String
        Dim strOut As String
        Dim strFile As String
        薄暗い strLPart を文字列として
        暗い strRPart を文字列として
        文字列として暗い lngCnt
        暗い lngFiles As Long
        ws = Sheets("MRT") を設定します
        lngCnt = Application.CountA(ws.Columns("A"))
        lngCnt = 0 の場合、Sub を終了します
        strIn = "C:\inserver6\script\Toolbelt\MRTesting\"
        strOut = "C:\inserver6\script\Toolbelt\MRTesting\"
        strFile = "MRTesting.tif"
        'ファイル名の文字列部分を抽出し、コピー ループの外側に入力します
        strLPart = Left$(strFile, InStr(strFile, ".") - 1)
        strRPart = Right$(strFile, Len(strFile) - Len(strLPart))
        lngFiles = 1 の場合 lngCnt へ
            FileCopy strIn & strFile, strOut & strLPart & "(" & lngFiles & ")" & strRPart
        次
    サブ終了

私はまだ初心者で、これを 8 時間試しましたが、うまくいきません。これは、単純に列挙して複製するための作業コードです。まったく異なるアプローチが必要な場合は、アイデアを提供してください。前もって感謝します。

4

1 に答える 1

2

入力を正しく理解していれば (画面は非常に役に立ちました)、次のコードが機能します。

Sub CloneImage()

Dim SampleFile As String
Dim SampleFileExt As String
Dim OutputFolder As String
Dim ResultFile As String
Dim CurrentName As String
Dim FSO As Object
Dim i As Long
Dim CopyCount As Long

SampleFile = "D:\DOCUMENTS\1.gif"
OutputFolder = "D:\DOCUMENTS\1\"
Set FSO = CreateObject("Scripting.FileSystemObject")
CopyCount = 0
Application.ScreenUpdating = False

If FSO.FileExists(SampleFile) = True Then
    SampleFileExt = "." & FSO.GetExtensionName(SampleFile)
Else
    MsgBox "Source file:" & vbNewLine & SampleFile & vbNewLine & "does not exist!"
    Exit Sub
End If

If FSO.FolderExists(OutputFolder) = False Then FSO.CreateFolder OutputFolder

For i = 2 To ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Rows.Count

    CurrentName = ThisWorkbook.ActiveSheet.Cells(i, 1).Value
    ResultFile = OutputFolder & CurrentName & SampleFileExt
    ThisWorkbook.ActiveSheet.Cells(i, 2).Formula = ResultFile
    ThisWorkbook.ActiveSheet.Cells(i, 3).Formula = CurrentName & ": " & ResultFile
    If FSO.FileExists(ResultFile) = False Then
        FSO.CopyFile SampleFile, ResultFile
        CopyCount = CopyCount + 1
    Else
        MsgBox "Destination file:" & vbNewLine & ResultFile & vbNewLine & "already exists!"
    End If

Next i

ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Columns.AutoFit

Application.ScreenUpdating = True
Set FSO = Nothing

MsgBox i - 2 & " string(s) processed," & vbNewLine & CopyCount & " file(s) created in:" & vbNewLine & OutputFolder

End Sub

前提と制限:

  1. ソースファイルが見つからないことを警告します。
  2. ファイル拡張子はソースから取得されます。
  3. 出力フォルダーは自動的に作成されます (存在しない場合)。
  4. 既存の宛先ファイルについて警告します。
  5. 処理された文字列/ファイルの数を含む最終メッセージ。

サンプル ファイルも共有されています: https://www.dropbox.com/s/jhbkwzuxzt01kzs/CloneImage.xlsm

お役に立てば幸いです。

于 2013-01-26T18:45:45.300 に答える