Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long
Public Const OFN_ALLOWMULTISELECT = &H200&
Public Const OFN_EXPLORER = &H80000
Public Const OFN_FILEMUSTEXIST = &H1000&
Public Const OFN_HIDEREADONLY = &H4&
Public Const OFN_PATHMUSTEXIST = &H800&
Sub ShowFileOpenDialog(ByRef FileList As Collection)
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim FileDir As String
Dim FilePos As Long
Dim PrevFilePos As Long
With OpenFile
.lStructSize = Len(OpenFile)
.hwndOwner = 0
.hInstance = 0
.lpstrFilter = "Arquivos CSV" + Chr(0) + "*.csv" + _
Chr(0) + "All Files (*.*)" + Chr(0) + "*.*" + Chr(0) + Chr(0)
.nFilterIndex = 1
.lpstrFile = String(4096, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = "C:\"
.lpstrTitle = "Load Images"
.flags = OFN_HIDEREADONLY + _
OFN_PATHMUSTEXIST + _
OFN_FILEMUSTEXIST + _
OFN_EXPLORER
lReturn = GetOpenFileName(OpenFile)
If lReturn <> 0 Then
FilePos = InStr(1, .lpstrFile, Chr(0))
If Mid(.lpstrFile, FilePos + 1, 1) = Chr(0) Then
FileList.Add .lpstrFile
Else
FileDir = Mid(.lpstrFile, 1, FilePos - 1)
Do While True
PrevFilePos = FilePos
FilePos = InStr(PrevFilePos + 1, .lpstrFile, Chr(0))
If FilePos - PrevFilePos > 1 Then
FileList.Add FileDir + "\" + _
Mid(.lpstrFile, PrevFilePos + 1, _
FilePos - PrevFilePos - 1)
Else
Exit Do
End If
Loop
End If
End If
End With
End Sub
Sub MontaCarteiras()
Dim FileList As New Collection
Dim SelectedFile As String
Dim f_in As Integer
Dim dup1 As Shape
Dim p1 As Page
Dim inLine As String
Dim curso As String
f_in = FreeFile
curso = InputBox("Nome do Curso ?")
ShowFileOpenDialog FileList
With FileList
If .Count > 0 Then
SelectedFile = .Item(1)
Else
MsgBox "Escolha um arquivo"
Exit Sub
End If
End With
On Error GoTo FileError ' Resume Next
Open SelectedFile For Input As f_in
Dim I As Integer
I = 0
Do While Not EOF(f_in)
Line Input #f_in, inLine
fields = Split(inLine, ";")
ActiveDocument.Pages(1).Activate
Set dup1 = ActivePage.Shapes.First.Duplicate(0.25, 0.25)
dup1.Move 3.193984, -0.337028
Set p1 = ActiveDocument.AddPages(1)
p1.Activate
dup1.AlignToPageCenter cdrAlignHCenter + cdrAlignVCenter, cdrTextAlignBoundingBox
dup1.Shapes(1).Text.Story.Text = StrConv(fields(1), vbProperCase)
dup1.Shapes(2).Text.Story.Text = "Matrcula " & fields(0) & " RG " & fields(2)
dup1.Shapes(3).Text.Story.Text = curso
dup1.UngroupAllEx
I = I + 1
Loop
Close f_in
MsgBox I & " Carteirinhas Lidas"
GoTo Fim
FileError:
MsgBox "Erro Lendo o Arquivo"
Fim: