marine_volria
XLDnaute Nouveau
Bonjour,
Pourriez vous me dire pourquoi j'ai un bug sur la ligne 141 """"""shortsn = Left(strTEMP, InStr(strTEMP, "-") - 1)"""""" on me dit argument ou appel de procédure incorrect je comprends pas trop pourquoi.
Merci d'avance pour votre aide.
Pourriez vous me dire pourquoi j'ai un bug sur la ligne 141 """"""shortsn = Left(strTEMP, InStr(strTEMP, "-") - 1)"""""" on me dit argument ou appel de procédure incorrect je comprends pas trop pourquoi.
Merci d'avance pour votre aide.
Code:
Sub Docx_en_P_pdf()
ActiveDocument.Save
'sauvegarde doc
path1 = ActiveDocument.Path
FileName = ActiveDocument.Name
'Chemin prendre doc actif
'Nom du doc prendre le doc actif
FileName = Left(FileName, Len(FileName) - 5)
ChangeFileOpenDirectory path1 & "\"
ActiveDocument.SaveAs2 FileName:=FileName & ".docx", _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
'prendre le docx
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
path1 & "\" & FileName & "-P.pdf", ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
'transformer en -P.pdf
ActiveDocument.Save
' sauvegarder le docuement actif
End Sub
Sub Docx_en_R0_docx()
ActiveDocument.Save
path1 = ActiveDocument.Path
FileName = ActiveDocument.Name
FileName = Left(FileName, Len(FileName) - 5)
ChangeFileOpenDirectory path1 & "\"
ActiveDocument.SaveAs2 FileName:=FileName & ".docx", _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
path1 & "\" & FileName & "-R0.docx", ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
ActiveDocument.Save
End Sub
Sub insérerfilename()
Selection.InsertBefore Text:=Left(ActiveDocument.Name, _
Len(ActiveDocument.Name) - 5)
End Sub
Sub Pied_de_page_auto()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.TypeBackspace
Selection.HomeKey Unit:=wdLine
End Sub
Sub Insertion_date_auto()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
:=True, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
End Sub
Sub Rapports_automatiques_génération_Par_appel()
'Macro d'éxécution générale
Docx_en_P_pdf
Docx_en_R0_docx
insérerfilename
Pied_de_page_auto
Insertion_date_auto
End Sub
Function IsNumeric1(LeMot As String)
Dim i As Integer
i = Len(LeMot)
Dim test As Boolean
test = True
' chh = Asc(Mid(LeMot, i))
While i <> 0 And test
test = Asc(Mid(LeMot, i)) > 47 And Asc(Mid(LeMot, i)) < 58
i = i - 1
Wend
IsNumeric1 = (i = 0)
' With ActiveDocument.Range(Start:=deb, End:=fin) 'emplacement du signet
' .Bookmarks.Add Name:=Nom 'ajoute le signet
' End With
End Function
Sub filen()
'ggggf parts = Split(Inputfolder, "\")
' a = parts(UBound(parts()))
' MsgBox ("File is: " & a)
Dim strFileName As String
Dim strTEMP As String
Dim shortsn As String
Dim longsn As String
Dim dateinter As String
Dim dateinterlabel As String
strFileName = ThisDocument.Name
strTEMP = Right(strFileName, Len(strFileName) - InStr(strFileName, "-"))
shortsn = Left(strTEMP, InStr(strTEMP, "-") - 1)
strTEMP = Right(strTEMP, Len(strTEMP) - InStr(strTEMP, "-"))
longsn = Left(strTEMP, InStr(strTEMP, "-") - 1)
strTEMP = Left(strTEMP, InStrRev(strTEMP, ".") - 1)
dateinter = Right(strTEMP, Len(strTEMP) - InStrRev(strTEMP, "-"))
While Len(dateinter) <> 6 Or Not (IsNumeric1(dateinter))
strTEMP = Left(strTEMP, Len(strTEMP) - Len(dateinter) - 1)
dateinter = Right(strTEMP, Len(strTEMP) - InStrRev(strTEMP, "-"))
Wend
yearinter = Left(dateinter, 2)
dayinter = Right(dateinter, 2)
monthinter = Right(Left(dateinter, 4), 2)
dateinterlabel = Format(CDate(dayinter & "/" & monthinter & "/" & yearinter), "dddd d mmmm yyyy")
TextBox1.Font.Size = 10
TextBox2.Font.Size = 10
TextBox3.Font.Size = 10
TextBox3.Text = dateinterlabel
TextBox2.Text = longsn
TextBox1.Text = shortsn
' TextBox1000.Font.Size = 10
' TextBox1016.Font.Size = 7
' TextBox1018.Font.Size = 7
' TextBox1020.Font.Size = 7
' TextBox1017.Font.Size = 8
' TextBox1019.Font.Size = 8
' TextBox1021.Font.Size = 8
End Sub
Private Sub Document_Open()
filen
End Sub