Sub A_MACROBLOG1() 'Version 09/04/2008 Rev 3 ©
'
'
' Macro enregistree le 06/04/2008 par lokistagnepas
' =============================================================
' Preparation et mise en forme du fichier WORD 2002 constitue
' a partir de 5 copier coller a la suite, depuis canablog
' Cela supprime les images et les remplace par du texte
' cela supprimera egalement les hyperlink des adresses IP.
' ou depuis la derniere date connue (Pas de Pb de taille)
' Avec introduction des chiffres complet de l'annee (>=Rev 2)
'


' Introduction du code du blog LOkistagnepas ou BRricolsec
' Cas ou on a plusieurs blog, on donne un code à 2 lettres
'
    Selection.HomeKey Unit:=wdStory
    codblog = InputBox("Donner les 2 premiers caractères du Blog", "Conversion vers fichier BLOGSTAT.TXT", "code du Blog 2 caract")
    codblog = codblog
    
'
' Save Fichier d'Origine en BLOGESS.DOC
'
 
    
        ActiveDocument.SaveAs FileName:="BLOGESS.DOC", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
'
    
'
' mise en forme du fichier
'
    Application.DisplayStatusBar = True
    Application.ShowWindowsInTaskbar = True
    Application.ShowStartupDialog = False
    With ActiveWindow
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayLeftScrollBar = False
        .StyleAreaWidth = CentimetersToPoints(0)
        .DisplayVerticalRuler = True
        .DisplayRightRuler = False
        .DisplayScreenTips = True
        With .View
            .ShowAnimation = True
            .Draft = False
            .WrapToWindow = False
            .ShowPicturePlaceHolders = False
            .ShowFieldCodes = False
            .ShowBookmarks = True
            .FieldShading = wdFieldShadingWhenSelected
            .ShowTabs = False
            .ShowSpaces = False
            .ShowParagraphs = False
            .ShowHyphens = False
            .ShowHiddenText = False
            .ShowAll = True
            .ShowDrawings = True
            .ShowObjectAnchors = True
            .ShowTextBoundaries = False
            .ShowHighlight = True
            .DisplayPageBoundaries = True
            .DisplaySmartTags = True
        End With
    End With
    Selection.HomeKey Unit:=wdStory 'suppression derniere colonne
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.Columns.Delete
    Selection.HomeKey Unit:=wdStory  'suppression colonne resolution
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.SelectColumn
    Selection.Delete Unit:=wdCharacter, Count:=1
 '
    Selection.Tables(1).Select 'selection table pour conv en texte
    Selection.Rows.ConvertToText Separator:=wdSeparateByCommas, NestedTables:= _
        True
    Selection.HomeKey Unit:=wdStory 'ctrl home puis affichage option code champ
    ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
    Application.DisplayStatusBar = True
    Application.ShowWindowsInTaskbar = True
    Application.ShowStartupDialog = False
    With ActiveWindow
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayLeftScrollBar = False
        .StyleAreaWidth = CentimetersToPoints(0)
        .DisplayVerticalRuler = True
        .DisplayRightRuler = False
        .DisplayScreenTips = True
        With .View
            .ShowAnimation = True
            .Draft = False
            .WrapToWindow = False
            .ShowPicturePlaceHolders = False
            .ShowFieldCodes = True
            .ShowBookmarks = True
            .FieldShading = wdFieldShadingWhenSelected
            .ShowTabs = False
            .ShowSpaces = False
            .ShowParagraphs = False
            .ShowHyphens = False
            .ShowHiddenText = False
            .ShowAll = True
            .ShowDrawings = True
            .ShowObjectAnchors = True
            .ShowTextBoundaries = False
            .ShowHighlight = True
            .DisplayPageBoundaries = True
            .DisplaySmartTags = True
        End With
    End With




'____________________________

' Recherches codes à partir d'un tableau de constantes
'
Dim TBL(50, 2)
' Codes de PAYS
TBL(1, 1) = "/FR.gif""": TBL(1, 2) = "FR" 'France
TBL(2, 1) = "/US.gif""": TBL(2, 2) = "US" 'Etats Unis
TBL(3, 1) = "/DZ.gif""": TBL(3, 2) = "DZ" 'Algerie
TBL(4, 1) = "/MA.gif""": TBL(4, 2) = "MA" 'Maroc
TBL(5, 1) = "/BE.gif""": TBL(5, 2) = "BE" 'Belgique
TBL(6, 1) = "/AF.gif""": TBL(6, 2) = "AF" 'Afghanistan
TBL(7, 1) = "/CA.gif""": TBL(7, 2) = "CA" 'Canada
TBL(8, 1) = "/DE.gif""": TBL(8, 2) = "DE" 'Allemagne
TBL(9, 1) = "/ES.gif""": TBL(9, 2) = "ES" 'Espagne
TBL(10, 1) = "/BF.gif""": TBL(10, 2) = "BF" 'Burkina Fasso
TBL(11, 1) = "/SN.gif""": TBL(11, 2) = "SN" 'Senegal
TBL(12, 1) = "/QA.gif""": TBL(12, 2) = "QA" 'QATAR
TBL(13, 1) = "/IT.gif""": TBL(13, 2) = "IT" 'Italie
TBL(14, 1) = "/RE.gif""": TBL(14, 2) = "RE" 'Reunion
TBL(15, 1) = "/GB.gif""": TBL(15, 2) = "UK" 'Grande Bretagne
TBL(16, 1) = "/CH.gif""": TBL(16, 2) = "CH" 'Suisse
TBL(17, 1) = "/BJ.gif""": TBL(17, 2) = "BJ" 'Benin
TBL(18, 1) = "/BR.gif""": TBL(18, 2) = "BR" 'Bresil
TBL(19, 1) = "/GY.gif""": TBL(19, 2) = "GY" 'Guyane
TBL(20, 1) = "/TN.gif""": TBL(20, 2) = "TN" 'Tunisie
TBL(21, 1) = "/LU.gif""": TBL(21, 2) = "LU" 'Luxembourg
TBL(22, 1) = "/NL.gif""": TBL(22, 2) = "NL" 'Pays Bas
TBL(23, 1) = "/PL.gif""": TBL(23, 2) = "PL" 'Pologne
TBL(24, 1) = "/RE.gif""": TBL(24, 2) = "RE" 'Reunion
TBL(25, 1) = "/PT.gif""": TBL(25, 2) = "PT" 'Portugal
TBL(26, 1) = "/ZA.gif""": TBL(26, 2) = "ZA" 'Afrique du Sud
TBL(27, 1) = "/NC.gif""": TBL(27, 2) = "NC" 'Nouvelle Calédonie
TBL(28, 1) = "/ZZ.gif""": TBL(28, 2) = "ZZ" '
TBL(29, 1) = "/ZZ.gif""": TBL(29, 2) = "ZZ" '

'OPERATING SYSTEMS

TBL(30, 1) = "/windows2000.png""": TBL(30, 2) = "WI20" 'Windows 2000
TBL(31, 1) = "/windows2003.png""": TBL(31, 2) = "WI03" 'Windows 2003
TBL(32, 1) = "/windowsxp.png""": TBL(32, 2) = "WIXP" 'Windows XP
TBL(33, 1) = "/windowsvista.png""": TBL(33, 2) = "WIVI" 'Windows VISTA
TBL(34, 1) = "/linux.png""": TBL(34, 2) = "LINU" 'LINUX
TBL(35, 1) = "/macosx.png""": TBL(35, 2) = "MAOS" 'Mac OS
TBL(36, 1) = "/windows.png""": TBL(36, 2) = "WINS" 'Windows Standard
TBL(37, 1) = "/windows98.png""": TBL(37, 2) = "WI98" 'Windows98
TBL(38, 1) = "/ZZ.png""": TBL(38, 2) = "ZZ" '
TBL(39, 1) = "/ZZ.gif""": TBL(39, 2) = "ZZ" '

'Navigateurs

TBL(40, 1) = "/fire.png""": TBL(40, 2) = "FIRE" 'Fire Fox
TBL(41, 1) = "/msie.png""": TBL(41, 2) = "MSIE" 'Micro Soft internet Explorer
TBL(42, 1) = "/konq.png""": TBL(42, 2) = "KONQ" 'Conqueror
TBL(43, 1) = "/oper.png""": TBL(43, 2) = "OPER" 'OPERA
TBL(44, 1) = "/safa.png""": TBL(44, 2) = "SAFA" 'Safari
TBL(45, 1) = "/ZZ.png""": TBL(45, 2) = "ZZ" '
TBL(46, 1) = "/ZZ.png""": TBL(46, 2) = "ZZ" '
TBL(47, 1) = "/ZZ.png""": TBL(47, 2) = "ZZ" '
TBL(48, 1) = "/ZZ.png""": TBL(48, 2) = "ZZ" '
TBL(49, 1) = "/ZZ.gif""": TBL(49, 2) = "ZZ" '
TBL(50, 1) = "/ZZ.gif""": TBL(50, 2) = "ZZ" '

'Ajouts au TABLEAU dans le desordre


For Line = 1 To 50 'Ne pas oublier de corriger le max si augmentation de taille tableau

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
   
    With Selection.Find
        .Text = TBL(Line, 1) + " \" + Chr(42) + " MERGEFORMATINET "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Do
        If Selection.Find.Execute = True Then
        trouv = True
        Selection.Extend
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:=TBL(Line, 2)
        windfindmatch = windfindmatch + 1
        Else
        trouv = False
        End If
                       
    Loop While trouv = True
    

Next

'
'sequence de fin
'OUTILS options
'
    ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
    Application.DisplayStatusBar = True
    Application.ShowWindowsInTaskbar = True
    Application.ShowStartupDialog = False
    With ActiveWindow
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayLeftScrollBar = False
        .StyleAreaWidth = CentimetersToPoints(0)
        .DisplayVerticalRuler = True
        .DisplayRightRuler = False
        .DisplayScreenTips = True
        With .View
            .ShowAnimation = True
            .Draft = False
            .WrapToWindow = False
            .ShowPicturePlaceHolders = False
            .ShowFieldCodes = False
            .ShowBookmarks = True
            .FieldShading = wdFieldShadingWhenSelected
            .ShowTabs = False
            .ShowSpaces = False
            .ShowParagraphs = False
            .ShowHyphens = False
            .ShowHiddenText = False
            .ShowAll = True
            .ShowDrawings = True
            .ShowObjectAnchors = True
            .ShowTextBoundaries = False
            .ShowHighlight = True
            .DisplayPageBoundaries = True
            .DisplaySmartTags = True
        End With
    End With
'
' Mise en place du code de blog (2 Caractères)
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    codblog = ";" + codblog + ";"
    With Selection.Find
        .Text = "; ;"
        .Replacement.Text = codblog
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll 'assure remplacement toutes les lignes

'
' Suppression des éventuels espaces qui trainent
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'
' OMIT CRLF
' Macro enregistree le 07/04/2008 par
'
    Selection.EndKey Unit:=wdStory
    Selection.TypeBackspace

'
' Introduction de "20" dans l'annee
' Car l'origine ne le comprend pas
'
    Selection.HomeKey Unit:=wdStory
 
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "/??;"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    
    Do
      If Selection.Find.Execute = True Then
        trouv = True
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:="20" 'Introduction Annee milliers et cent
                                       Else
        trouv = False
       End If
     
     Loop While trouv = True
    
     Selection.HomeKey Unit:=wdStory 'CTRL Home

'
' Save format BLOGSTAT.TXT
'
    ActiveDocument.SaveAs FileName:="BLOGSTAT.txt", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
        , LineEnding:=wdCRLF, AddBiDiMarks:=False
'
' fermeture fichiers ouverture BLOGSTAT.TXT
' Selection et CTRL+C pour inserer dans ACCESS
' Macro enregistree le 07/04/2008 par CT
'
    ActiveDocument.Close
    Documents.Open FileName:="BLOGSTAT.TXT", ConfirmConversions:=True, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, Encoding:=1252, _
        DocumentDirection:=wdLeftToRight
    Selection.WholeStory
    Selection.Copy
    
    MsgBox ("Fin de traitement complétez éventuellement")
      

End Sub