| |
こんにちは
お世話になります
csvでシールラベルを作るVBAがあったのですが、
csvの内容、セルの順番が変わってから起動しなくなってしまいました。
どうにか再度使えるようにしたいのですが、csvの読見込みができなくて。
セルの読み込み条件などってここのモジュールのほうじゃなく、シート１のほうのVBAでよろしいでしょうか？また、どういう変更を行えばいいなど、アドバイスありましたらお伺いしたいです。
お手数ではございますが、よろしくお願いします。
Public Sub Set2_6タイプデータ設定処理(ByVal strCsvMode As String)
Dim vntFileName As Variant
Dim intSheetIdx As Long
Dim intSheetIdxCount As Long
Dim csvFile As String
Dim ch As Long
Dim i As Long
Dim csvStr As String
Dim StrCsv() As String
'===========================================================
' ファイルを選択ダイアログオープン処理
'===========================================================
vntFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="データプールファイル" _
, MultiSelect:=False _
)
'===========================================================
' 選択ファイルオープン処理
'===========================================================
If vntFileName = False Then
Exit Sub
End If
'===========================================================
' 新規ブック作成処理
'===========================================================
Dim NewBook As Workbook
Dim strWkBookName As String
'-----------------------------------------------------------
'新しいブック作成 名前取得処理
'-----------------------------------------------------------
Set NewBook = Workbooks.Add
strWkBookName = NewBook.Name
'===========================================================
'CSVファイル名
'===========================================================
csvFile = vntFileName
'===========================================================
'空いている番号を取得
'===========================================================
ch = FreeFile
'===========================================================
' CSVファイルオープン
'===========================================================
Open csvFile For Input As #ch
'===========================================================
'インデックスリセット
'===========================================================
i = 1
intSheetIdx = 1
intSheetIdxCount = 1
'===========================================================
'CSVファイル読込
'===========================================================
Do While Not EOF(1)
'-------------------------------------------------------
'１行読込処理
'-------------------------------------------------------
Line Input #ch, csvStr
'-------------------------------------------------------
'カンマ区切りで配列に格納
'-------------------------------------------------------
csvStr = Replace(csvStr, """", "")
csvStr = Replace(csvStr, "'", "")
'=======================================================
'CSVファイルチェック
'=======================================================
If i = 1 Then
If ChkCSVデータ(csvStr, strCsvMode) = "NG" Then
Close #ch
Application.DisplayAlerts = False
Workbooks(strWkBookName).Close
Application.DisplayAlerts = True
MsgBox "選択したファイルはデータプールCSVではありません。", vbOKOnly + vbExclamation
Exit Sub
End If
Else
'-----------------------------------------------------------
'シート コピー処理
'-----------------------------------------------------------
If intSheetIdxCount = 1 Then
ThisWorkbook.Worksheets("2×6タイプ").Copy Before:=Worksheets("Sheet1")
Workbooks(strWkBookName).Worksheets("2×6タイプ").Name = CStr(intSheetIdx)
End If
'=======================================================
'書き込み処理
'=======================================================
Set2_6セルデータ strCsvMode, csvStr, strWkBookName, i, intSheetIdx, intSheetIdxCount
'-------------------------------------------------------
' シートインデックス処理 125
'-------------------------------------------------------
If intSheetIdxCount >= 12 Then
'シートカウント
intSheetIdx = intSheetIdx + 1
'行カウント
intSheetIdxCount = 1
'シート数125で終了(1,500行分)
If intSheetIdx > 125 Then
MsgBox "1,500行を超えました。以降は別途作成してください。", vbOKOnly + vbInformation
Exit Do
End If
Else
'行カウント
intSheetIdxCount = intSheetIdxCount + 1
End If
End If
'-------------------------------------------------------
'インクリメント
'-------------------------------------------------------
i = i + 1
Loop
'-----------------------------------------------------------
'ファイルクローズ
'-----------------------------------------------------------
Close #ch
'-----------------------------------------------------------
'終了メッセージ
'-----------------------------------------------------------
MsgBox "作成完了"
End Sub
|
|
よろずや
- 22/2/27(日) 22:23 -
ちか
- 22/2/27(日) 22:08 -
よろずや
- 22/2/27(日) 18:58 -
サンキョウ
- 22/2/27(日) 11:12 -
- 22/2/24(木) 13:14 -
